NCEPLIBS-w3emc 2.12.0
Loading...
Searching...
No Matches
orders.f
Go to the documentation of this file.
1C> @file
2C> @brief A Fast and stable sort routine suitable for efficient,
3C> multiple-pass sorting on variable length characters, integers, or
4C> real numbers.
5C> @author Jack Woollen @date 1999-06-03
6
7C> Orders is a fast and stable sort routine suitable for efficient,
8C> multiple-pass sorting on variable length characters, integers, or
9C> real numbers. The algorithm derives from the radix or bucket sort
10C> procedure. The form of the orders subroutine is defined by a cray
11C> man page. The sort works by computing frequency distribution of the
12C> set of sort keys and using that as a map of the reordered data.
13C> Orders rearranges indexes instead of the sort keys, which simplifies
14C> multi-pass record sorting. The radix of the sort determines how many
15C> "buckets" there are in the frequency distribution array. The larger
16C> the radix the more buckets. The simplest is a one bit radix, which
17C> has two buckets, and requires as many passes through the keys as
18C> the keys have bits. A one byte radix requires less passes through
19C> the data with more buckets (256 to be exact). The one byte radix
20C> is implemented here. An additional complication is the fact that
21C> radix sort only works on key sets of positive values, so this
22C> implementation includes a biasing of the (numeric) keys before
23C> sorting. To save space the keys themselves are adjusted and then
24C> readjusted before returning. A simple example of a one bit radix
25C> sort on a list of four, four bit, numbers is diagramed below to
26C> illustrate the concept.
27C>
28C> <pre>
29C>-----------------------------------------------------------------------
30C> PASS1 > PASS2 > PASS3 > PASS4 > FINISHED
31C>-----------------------------------------------------------------------
32C> | | | |
33C> THE LIST 0011 0100 0100 1001 0011
34C> 0101 0011 0101 0011 0100
35C> 1001 0101 1001 0100 0101
36C> 0100 1001 0011 0101 1001
37C>-----------------------------------------------------------------------
38C> BUCKET 0 0100 0100 1001 0011
39C> | 0101 0011 0100
40C> | 1001 | 0101
41C>-----------------------------------------------------------------------
42C> BUCKET 1 0011 0011 0100 1001
43C> 0101 | 0101 |
44C> 1001 | | |
45C>-----------------------------------------------------------------------
46C> </pre>
47C>
48C> PROGRAM HISTORY LOG:
49C> - Jack Woollen 1998-02-21 Original version for implementation
50C> - Boi Vuong 1998-04-11 Replaced operand .and. with intrinsic iand
51C> - D. Keyser 1999-06-03 Modified to port to ibm sp and run in 4 or
52C> 8 Byte storage
53C> - Jack Woollen 1999-06-09 Added potential for four or eight byte keys
54C> in either a four or eight byte environment
55C> - Jack Woollen 2012-09-16 Made sorting characters work on little endian
56C>
57C> INPUT ARGUMENTS:
58C> @param[in] IN Indicator of key form and index state.
59C> - IN = 0 Initialize indexes and sort characters.
60C> - IN = 1 Initialize indexes and sort integers.
61C> - IN = 2 Initialize indexes and sort real numbers.
62C> - IN = 10 Sort characters with indexes as is.
63C> - IN = 11 Sort integers with indexes as is.
64C> - IN = 12 Sort real numbers with indexes asis.
65C> @param[in] ISORT Work array with the same dimension as idata.
66C> @param[in] IDATA Array of sort keys as described by in.
67C> @param[out] INDEX Array of indexes representing the sorted idata.
68C> @param[in] N Dimension of isort, idata, and index.
69C> @param[in] M Offset (in key-words) between successive members of idata.
70C> @param[in] I1 Byte length of the key-words.
71C> @param[in] I2 Not used; Included for compatability with original cray
72C> routine.
73C>
74C> @note The one byte radix method was selected for orders because it
75C> offers a good ratio of memory requirement to operation count
76C> for producing a sort. Because of recursive manipulation of indexes
77C> in one of the loops, this may actually take slightly longer on some
78C> vector machines than a (more work intensive) one bit radix method.
79C> In general, though, the one byte method is faster. Any larger radix
80C> presents exponentially increasing memory required. Note that the
81C> implementation uses very little local data space, and only modest
82C> user-supplied memory.
83C>
84C> @author Jack Woollen @date 1999-06-03
85 SUBROUTINE orders(IN,ISORT,IDATA,INDEX,N,M,I1,I2)
86
87 dimension isort(n),index(n)
88 INTEGER(8) IDATA(M,N),ICHEK,IBYT
89 REAL(8) SMAL,RCHEK
90 dimension indx(0:255),kndx(0:255)
91 equivalence(ichek,rchek)
92
93C-----------------------------------------------------------------------
94C-----------------------------------------------------------------------
95
96C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
97C -------------------------------------------------------------------
98
99 itype = mod(in,10)
100 IF(in.LT.10) THEN
101 DO i=1,n
102 index(i) = i
103 ENDDO
104 ENDIF
105
106c call different branches for different types of keys
107c ---------------------------------------------------
108
109 IF(i1.EQ.4) THEN
110 if(itype==0) CALL ordec4(in,isort,idata,index,n,m,i1,i2)
111 if(itype/=0) CALL order4(in,isort,idata,index,n,m,i1,i2)
112 RETURN
113 ELSEIF(i1.EQ.8) then
114 IF(itype==0) CALL ordec8(in,isort,idata,index,n,m,i1,i2)
115 IF(itype==0) RETURN
116 ELSEIF(i1.NE.8) THEN
117 print*,'ORDERS argument i1 (keyword size) can be 4 or 8'
118 print*,'ORDERS argument i1 here=',i1
119 CALL errexit(99_4)
120 ENDIF
121
122C COMPUTE A POSITIVE BIAS FOR INTEGER OR REAL NUMBERS
123C ---------------------------------------------------
124
125 IF(itype.GT.0) THEN
126 smal = 1
127 DO i=1,n
128 ichek = idata(1,i)
129 IF(itype.EQ.1 .AND. ichek.LT.smal) smal = ichek
130 IF(itype.EQ.2 .AND. rchek.LT.smal) smal = rchek
131 ENDDO
132 smal = 1-smal
133 DO i=1,n
134 ichek = idata(1,i)
135 IF(itype.EQ.1) ichek = ichek+smal
136 IF(itype.EQ.2) rchek = rchek+smal
137 idata(1,i) = ichek
138 ENDDO
139 ENDIF
140
141C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
142C -------------------------------------------------------------------
143
144 DO ibyt=0,i1-1
145
146 kndx(0) = 1
147 DO i=0,255
148 indx(i) = 0
149 ENDDO
150
151 DO i=1,n
152 jbyt = iand(ishft(idata(1,index(i)),-ibyt*8_8),255_8)
153 indx(jbyt) = indx(jbyt)+1
154 isort(i) = index(i)
155 ENDDO
156
157 DO i=1,255
158 kndx(i) = kndx(i-1)+indx(i-1)
159 ENDDO
160
161 DO i=1,n
162 jbyt = iand(ishft(idata(1,isort(i)),-ibyt*8_8),255_8)
163 index(kndx(jbyt)) = isort(i)
164 kndx(jbyt) = kndx(jbyt)+1
165 ENDDO
166
167 ENDDO
168
169C UNBIAS THE INPUT ARRAY ON THE WAY OUT
170C -------------------------------------
171
172 IF(itype.GT.0) THEN
173 DO i=1,n
174 ichek = idata(1,i)
175 IF(itype.EQ.1) ichek = ichek-smal
176 IF(itype.EQ.2) rchek = rchek-smal
177 idata(1,i) = ichek
178 ENDDO
179 ENDIF
180
181C FINISHED!
182C ---------
183
184 RETURN
185 END
186C-----------------------------------------------------------------------
187C-----------------------------------------------------------------------
188 SUBROUTINE order4(IN,ISORT,IDATA,INDEX,N,M,I1,I2)
189
190 dimension isort(n),index(n)
191 INTEGER(4) IDATA(M,N),ICHEK,IBYT
192 REAL(4) SMAL,RCHEK
193 dimension indx(0:255),kndx(0:255)
194 equivalence(ichek,rchek)
195
196C-----------------------------------------------------------------------
197C-----------------------------------------------------------------------
198
199C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
200C -------------------------------------------------------------------
201
202 itype = mod(in,10)
203 IF(in.LT.10) THEN
204 DO i=1,n
205 index(i) = i
206 ENDDO
207 ENDIF
208
209C COMPUTE A POSITIVE BIAS FOR INTEGER OR REAL NUMBERS
210C ---------------------------------------------------
211
212 IF(itype.GT.0) THEN
213 smal = 1
214 DO i=1,n
215 ichek = idata(1,i)
216 IF(itype.EQ.1 .AND. ichek.LT.smal) smal = ichek
217 IF(itype.EQ.2 .AND. rchek.LT.smal) smal = rchek
218 ENDDO
219 smal = 1-smal
220 DO i=1,n
221 ichek = idata(1,i)
222 IF(itype.EQ.1) ichek = ichek+smal
223 IF(itype.EQ.2) rchek = rchek+smal
224 idata(1,i) = ichek
225 ENDDO
226 ENDIF
227
228C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
229C -------------------------------------------------------------------
230
231 DO ibyt=0,i1-1
232
233 kndx(0) = 1
234 DO i=0,255
235 indx(i) = 0
236 ENDDO
237
238 DO i=1,n
239 jbyt = iand(ishft(idata(1,index(i)),-ibyt*8_4),255_4)
240 indx(jbyt) = indx(jbyt)+1
241 isort(i) = index(i)
242 ENDDO
243
244 DO i=1,255
245 kndx(i) = kndx(i-1)+indx(i-1)
246 ENDDO
247
248 DO i=1,n
249 jbyt = iand(ishft(idata(1,isort(i)),-ibyt*8_4),255_4)
250 index(kndx(jbyt)) = isort(i)
251 kndx(jbyt) = kndx(jbyt)+1
252 ENDDO
253
254 ENDDO
255
256C UNBIAS THE INPUT ARRAY ON THE WAY OUT
257C -------------------------------------
258
259 IF(itype.GT.0) THEN
260 DO i=1,n
261 ichek = idata(1,i)
262 IF(itype.EQ.1) ichek = ichek-smal
263 IF(itype.EQ.2) rchek = rchek-smal
264 idata(1,i) = ichek
265 ENDDO
266 ENDIF
267
268C FINISHED!
269C ---------
270
271 RETURN
272 END
273C-----------------------------------------------------------------------
274C-----------------------------------------------------------------------
275 SUBROUTINE ordec8(IN,ISORT,IDATA,INDEX,N,M,I1,I2)
276
277 dimension isort(n),index(n)
278 character(8) IDATA(M,N)
279 dimension indx(0:255),kndx(0:255)
280
281C-----------------------------------------------------------------------
282C-----------------------------------------------------------------------
283
284C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
285C -------------------------------------------------------------------
286
287 itype = mod(in,10)
288 IF(in.LT.10) THEN
289 DO i=1,n
290 index(i) = i
291 ENDDO
292 ENDIF
293
294C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
295C -------------------------------------------------------------------
296
297 DO ibyt=0,i1-1
298
299 kndx(0) = 1
300 DO i=0,255
301 indx(i) = 0
302 ENDDO
303
304 ii=i1-ibyt
305
306 DO i=1,n
307 jbyt = ichar(idata(1,index(i))(ii:ii))
308 indx(jbyt) = indx(jbyt)+1
309 isort(i) = index(i)
310 ENDDO
311
312 DO i=1,255
313 kndx(i) = kndx(i-1)+indx(i-1)
314 ENDDO
315
316 DO i=1,n
317 jbyt = ichar(idata(1,isort(i))(ii:ii))
318 index(kndx(jbyt)) = isort(i)
319 kndx(jbyt) = kndx(jbyt)+1
320 ENDDO
321
322 ENDDO
323
324C FINISHED!
325C ---------
326
327 RETURN
328 END
329C-----------------------------------------------------------------------
330C-----------------------------------------------------------------------
331 SUBROUTINE ordec4(IN,ISORT,IDATA,INDEX,N,M,I1,I2)
332
333 dimension isort(n),index(n)
334 character(4) IDATA(M,N)
335 dimension indx(0:255),kndx(0:255)
336
337C-----------------------------------------------------------------------
338C-----------------------------------------------------------------------
339
340C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
341C -------------------------------------------------------------------
342
343 itype = mod(in,10)
344 IF(in.LT.10) THEN
345 DO i=1,n
346 index(i) = i
347 ENDDO
348 ENDIF
349
350C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
351C -------------------------------------------------------------------
352
353 DO ibyt=0,i1-1
354
355 kndx(0) = 1
356 DO i=0,255
357 indx(i) = 0
358 ENDDO
359
360 ii=i1-ibyt
361
362 DO i=1,n
363 jbyt = ichar(idata(1,index(i))(ii:ii))
364 indx(jbyt) = indx(jbyt)+1
365 isort(i) = index(i)
366 ENDDO
367
368 DO i=1,255
369 kndx(i) = kndx(i-1)+indx(i-1)
370 ENDDO
371
372 DO i=1,n
373 jbyt = ichar(idata(1,isort(i))(ii:ii))
374 index(kndx(jbyt)) = isort(i)
375 kndx(jbyt) = kndx(jbyt)+1
376 ENDDO
377
378 ENDDO
379
380C FINISHED!
381C ---------
382
383 RETURN
384 END
errexit
subroutine errexit(iret)
Exit with a return code.
Definition errexit.f:20
orders
subroutine orders(in, isort, idata, index, n, m, i1, i2)
Orders is a fast and stable sort routine suitable for efficient, multiple-pass sorting on variable le...
Definition orders.f:86