NCEPLIBS-w3emc  2.11.0
orders.f
Go to the documentation of this file.
1 C> @file
2 C> @brief A Fast and stable sort routine suitable for efficient,
3 C> multiple-pass sorting on variable length characters, integers, or
4 C> real numbers.
5 C> @author Jack Woollen @date 1999-06-03
6 
7 C> Orders is a fast and stable sort routine suitable for efficient,
8 C> multiple-pass sorting on variable length characters, integers, or
9 C> real numbers. The algorithm derives from the radix or bucket sort
10 C> procedure. The form of the orders subroutine is defined by a cray
11 C> man page. The sort works by computing frequency distribution of the
12 C> set of sort keys and using that as a map of the reordered data.
13 C> Orders rearranges indexes instead of the sort keys, which simplifies
14 C> multi-pass record sorting. The radix of the sort determines how many
15 C> "buckets" there are in the frequency distribution array. The larger
16 C> the radix the more buckets. The simplest is a one bit radix, which
17 C> has two buckets, and requires as many passes through the keys as
18 C> the keys have bits. A one byte radix requires less passes through
19 C> the data with more buckets (256 to be exact). The one byte radix
20 C> is implemented here. An additional complication is the fact that
21 C> radix sort only works on key sets of positive values, so this
22 C> implementation includes a biasing of the (numeric) keys before
23 C> sorting. To save space the keys themselves are adjusted and then
24 C> readjusted before returning. A simple example of a one bit radix
25 C> sort on a list of four, four bit, numbers is diagramed below to
26 C> illustrate the concept.
27 C>
28 C> <pre>
29 C>-----------------------------------------------------------------------
30 C> PASS1 > PASS2 > PASS3 > PASS4 > FINISHED
31 C>-----------------------------------------------------------------------
32 C> | | | |
33 C> THE LIST 0011 0100 0100 1001 0011
34 C> 0101 0011 0101 0011 0100
35 C> 1001 0101 1001 0100 0101
36 C> 0100 1001 0011 0101 1001
37 C>-----------------------------------------------------------------------
38 C> BUCKET 0 0100 0100 1001 0011
39 C> | 0101 0011 0100
40 C> | 1001 | 0101
41 C>-----------------------------------------------------------------------
42 C> BUCKET 1 0011 0011 0100 1001
43 C> 0101 | 0101 |
44 C> 1001 | | |
45 C>-----------------------------------------------------------------------
46 C> </pre>
47 C>
48 C> PROGRAM HISTORY LOG:
49 C> - Jack Woollen 1998-02-21 Original version for implementation
50 C> - Boi Vuong 1998-04-11 Replaced operand .and. with intrinsic iand
51 C> - D. Keyser 1999-06-03 Modified to port to ibm sp and run in 4 or
52 C> 8 Byte storage
53 C> - Jack Woollen 1999-06-09 Added potential for four or eight byte keys
54 C> in either a four or eight byte environment
55 C> - Jack Woollen 2012-09-16 Made sorting characters work on little endian
56 C>
57 C> INPUT ARGUMENTS:
58 C> @param[in] IN Indicator of key form and index state.
59 C> - IN = 0 Initialize indexes and sort characters.
60 C> - IN = 1 Initialize indexes and sort integers.
61 C> - IN = 2 Initialize indexes and sort real numbers.
62 C> - IN = 10 Sort characters with indexes as is.
63 C> - IN = 11 Sort integers with indexes as is.
64 C> - IN = 12 Sort real numbers with indexes asis.
65 C> @param[in] ISORT Work array with the same dimension as idata.
66 C> @param[in] IDATA Array of sort keys as described by in.
67 C> @param[out] INDEX Array of indexes representing the sorted idata.
68 C> @param[in] N Dimension of isort, idata, and index.
69 C> @param[in] M Offset (in key-words) between successive members of idata.
70 C> @param[in] I1 Byte length of the key-words.
71 C> @param[in] I2 Not used; Included for compatability with original cray
72 C> routine.
73 C>
74 C> @note The one byte radix method was selected for orders because it
75 C> offers a good ratio of memory requirement to operation count
76 C> for producing a sort. Because of recursive manipulation of indexes
77 C> in one of the loops, this may actually take slightly longer on some
78 C> vector machines than a (more work intensive) one bit radix method.
79 C> In general, though, the one byte method is faster. Any larger radix
80 C> presents exponentially increasing memory required. Note that the
81 C> implementation uses very little local data space, and only modest
82 C> user-supplied memory.
83 C>
84 C> @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 
93 C-----------------------------------------------------------------------
94 C-----------------------------------------------------------------------
95 
96 C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
97 C -------------------------------------------------------------------
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 
106 c call different branches for different types of keys
107 c ---------------------------------------------------
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 
122 C COMPUTE A POSITIVE BIAS FOR INTEGER OR REAL NUMBERS
123 C ---------------------------------------------------
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 
141 C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
142 C -------------------------------------------------------------------
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 
169 C UNBIAS THE INPUT ARRAY ON THE WAY OUT
170 C -------------------------------------
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 
181 C FINISHED!
182 C ---------
183 
184  RETURN
185  END
186 C-----------------------------------------------------------------------
187 C-----------------------------------------------------------------------
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 
196 C-----------------------------------------------------------------------
197 C-----------------------------------------------------------------------
198 
199 C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
200 C -------------------------------------------------------------------
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 
209 C COMPUTE A POSITIVE BIAS FOR INTEGER OR REAL NUMBERS
210 C ---------------------------------------------------
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 
228 C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
229 C -------------------------------------------------------------------
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 
256 C UNBIAS THE INPUT ARRAY ON THE WAY OUT
257 C -------------------------------------
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 
268 C FINISHED!
269 C ---------
270 
271  RETURN
272  END
273 C-----------------------------------------------------------------------
274 C-----------------------------------------------------------------------
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 
281 C-----------------------------------------------------------------------
282 C-----------------------------------------------------------------------
283 
284 C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
285 C -------------------------------------------------------------------
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 
294 C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
295 C -------------------------------------------------------------------
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 
324 C FINISHED!
325 C ---------
326 
327  RETURN
328  END
329 C-----------------------------------------------------------------------
330 C-----------------------------------------------------------------------
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 
337 C-----------------------------------------------------------------------
338 C-----------------------------------------------------------------------
339 
340 C DISCERN THE VARIABLE TYPE OF THE INPUT ARRAY, AND MAYBE SET INDEXES
341 C -------------------------------------------------------------------
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 
350 C SORT THE INPUT SET W/1BYTE RADIX - REARRANGE SORT LIST INDEXES ONLY
351 C -------------------------------------------------------------------
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 
380 C FINISHED!
381 C ---------
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