1!
2!     SLATEC: public domain
3!
4*deck isort
5      subroutine isorti(ix,n,kflag)
6!
7!     modified: auxiliary array was dropped
8!
9C***BEGIN PROLOGUE  ISORT
10C***PURPOSE  Sort an array and optionally make the same interchanges in
11C            an auxiliary array.  The array may be sorted in increasing
12C            or decreasing order.  A slightly modified QUICKSORT
13C            algorithm is used.
14C***LIBRARY   SLATEC
15C***CATEGORY  N6A2A
16C***TYPE      INTEGER (SSORT-S, DSORT-D, ISORT-I)
17C***KEYWORDS  SINGLETON QUICKSORT, SORT, SORTING
18C***AUTHOR  Jones, R. E., (SNLA)
19C           Kahaner, D. K., (NBS)
20C           Wisniewski, J. A., (SNLA)
21C***DESCRIPTION
22C
23C   ISORT sorts array IX and optionally makes the same interchanges in
24C   array IY.  The array IX may be sorted in increasing order or
25C   decreasing order.  A slightly modified quicksort algorithm is used.
26C
27C   Description of Parameters
28C      IX(2,*) - integer array of values to be sorted
29C      IX(1,*) - integer array to be (optionally) carried along
30C      N  - number of values in integer array IX to be sorted
31C      KFLAG - control parameter
32C            =  2  means sort IX(2,*) in increasing order and carry IX(1,*)
33C                  along.
34C            =  1  means sort IX(2,*) in increasing order (ignoring IX(1,*))
35C            = -1  means sort IX(2,*) in decreasing order (ignoring IX(1,*))
36C            = -2  means sort IX(2,*) in decreasing order and carry IX(1,*)
37C                  along.
38C
39C***REFERENCES  R. C. Singleton, Algorithm 347, An efficient algorithm
40C                 for sorting with minimal storage, Communications of
41C                 the ACM, 12, 3 (1969), pp. 185-187.
42C***ROUTINES CALLED  XERMSG
43C***REVISION HISTORY  (YYMMDD)
44C   761118  DATE WRITTEN
45C   810801  Modified by David K. Kahaner.
46C   890531  Changed all specific intrinsics to generic.  (WRB)
47C   890831  Modified array declarations.  (WRB)
48C   891009  Removed unreferenced statement labels.  (WRB)
49C   891009  REVISION DATE from Version 3.2
50C   891214  Prologue converted to Version 4.0 format.  (BAB)
51C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
52C   901012  Declared all variables; changed X,Y to IX,IY. (M. McClain)
53C   920501  Reformatted the REFERENCES section.  (DWL, WRB)
54C   920519  Clarified error messages.  (DWL)
55C   920801  Declarations section rebuilt and code restructured to use
56C           IF-THEN-ELSE-ENDIF.  (RWC, WRB)
57!   100411  changed the dimension of IL and IU from 21 to 31.
58!
59!     field IL and IU have the dimension 31. This is log2 of the largest
60!     array size to be sorted. If arrays larger than 2**31 in length have
61!     to be sorted, this dimension has to be modified accordingly
62!
63C***END PROLOGUE  ISORT
64!
65      implicit none
66C     .. Scalar Arguments ..
67      integer kflag, n
68C     .. Array Arguments ..
69      integer ix(2,*)
70C     .. Local Scalars ..
71      real r
72      integer i, ij, j, k, kk, l, m, nn, t, tt, tty, ty
73C     .. Local Arrays ..
74      integer il(31), iu(31)
75C     .. External Subroutines ..
76!      EXTERNAL XERMSG
77C     .. Intrinsic Functions ..
78      intrinsic abs, int
79C***FIRST EXECUTABLE STATEMENT  ISORT
80      nn = n
81      if (nn .lt. 1) then
82!         CALL XERMSG ('SLATEC', 'ISORT',
83!     +      'The number of values to be sorted is not positive.', 1, 1)
84         return
85      endif
86C
87      kk = abs(kflag)
88      if (kk.ne.1 .and. kk.ne.2) then
89!         CALL XERMSG ('SLATEC', 'ISORT',
90!     +      'The sort control parameter, K, is not 2, 1, -1, or -2.', 2,
91!     +      1)
92         return
93      endif
94C
95C     Alter array IX to get decreasing order if needed
96C
97      if (kflag .le. -1) then
98         do 10 i=1,nn
99            ix(2,i) = -ix(2,i)
100   10    continue
101      endif
102C
103      if (kk .eq. 2) go to 100
104C
105C     Sort IX only
106C
107      m = 1
108      i = 1
109      j = nn
110      r = 0.375e0
111C
112   20 if (i .eq. j) go to 60
113      if (r .le. 0.5898437e0) then
114         r = r+3.90625e-2
115      else
116         r = r-0.21875e0
117      endif
118C
119   30 k = i
120C
121C     Select a central element of the array and save it in location T
122C
123      ij = i + int((j-i)*r)
124      t = ix(2,ij)
125C
126C     If first element of array is greater than T, interchange with T
127C
128      if (ix(2,i) .gt. t) then
129         ix(2,ij) = ix(2,i)
130         ix(2,i) = t
131         t = ix(2,ij)
132      endif
133      l = j
134C
135C     If last element of array is less than than T, interchange with T
136C
137      if (ix(2,j) .lt. t) then
138         ix(2,ij) = ix(2,j)
139         ix(2,j) = t
140         t = ix(2,ij)
141C
142C        If first element of array is greater than T, interchange with T
143C
144         if (ix(2,i) .gt. t) then
145            ix(2,ij) = ix(2,i)
146            ix(2,i) = t
147            t = ix(2,ij)
148         endif
149      endif
150C
151C     Find an element in the second half of the array which is smaller
152C     than T
153C
154   40 l = l-1
155      if (ix(2,l) .gt. t) go to 40
156C
157C     Find an element in the first half of the array which is greater
158C     than T
159C
160   50 k = k+1
161      if (ix(2,k) .lt. t) go to 50
162C
163C     Interchange these elements
164C
165      if (k .le. l) then
166         tt = ix(2,l)
167         ix(2,l) = ix(2,k)
168         ix(2,k) = tt
169         go to 40
170      endif
171C
172C     Save upper and lower subscripts of the array yet to be sorted
173C
174      if (l-i .gt. j-k) then
175         il(m) = i
176         iu(m) = l
177         i = k
178         m = m+1
179      else
180         il(m) = k
181         iu(m) = j
182         j = l
183         m = m+1
184      endif
185      go to 70
186C
187C     Begin again on another portion of the unsorted array
188C
189   60 m = m-1
190      if (m .eq. 0) go to 190
191      i = il(m)
192      j = iu(m)
193C
194   70 if (j-i .ge. 1) go to 30
195      if (i .eq. 1) go to 20
196      i = i-1
197C
198   80 i = i+1
199      if (i .eq. j) go to 60
200      t = ix(2,i+1)
201      if (ix(2,i) .le. t) go to 80
202      k = i
203C
204   90 ix(2,k+1) = ix(2,k)
205      k = k-1
206      if (t .lt. ix(2,k)) go to 90
207      ix(2,k+1) = t
208      go to 80
209C
210C     Sort IX and carry IY along
211C
212  100 m = 1
213      i = 1
214      j = nn
215      r = 0.375e0
216C
217  110 if (i .eq. j) go to 150
218      if (r .le. 0.5898437e0) then
219         r = r+3.90625e-2
220      else
221         r = r-0.21875e0
222      endif
223C
224  120 k = i
225C
226C     Select a central element of the array and save it in location T
227C
228      ij = i + int((j-i)*r)
229      t = ix(2,ij)
230      ty = ix(1,ij)
231C
232C     If first element of array is greater than T, interchange with T
233C
234      if (ix(2,i) .gt. t) then
235         ix(2,ij) = ix(2,i)
236         ix(2,i) = t
237         t = ix(2,ij)
238         ix(1,ij) = ix(1,i)
239         ix(1,i) = ty
240         ty = ix(1,ij)
241      endif
242      l = j
243C
244C     If last element of array is less than T, interchange with T
245C
246      if (ix(2,j) .lt. t) then
247         ix(2,ij) = ix(2,j)
248         ix(2,j) = t
249         t = ix(2,ij)
250         ix(1,ij) = ix(1,j)
251         ix(1,j) = ty
252         ty = ix(1,ij)
253C
254C        If first element of array is greater than T, interchange with T
255C
256         if (ix(2,i) .gt. t) then
257            ix(2,ij) = ix(2,i)
258            ix(2,i) = t
259            t = ix(2,ij)
260            ix(1,ij) = ix(1,i)
261            ix(1,i) = ty
262            ty = ix(1,ij)
263         endif
264      endif
265C
266C     Find an element in the second half of the array which is smaller
267C     than T
268C
269  130 l = l-1
270      if (ix(2,l) .gt. t) go to 130
271C
272C     Find an element in the first half of the array which is greater
273C     than T
274C
275  140 k = k+1
276      if (ix(2,k) .lt. t) go to 140
277C
278C     Interchange these elements
279C
280      if (k .le. l) then
281         tt = ix(2,l)
282         ix(2,l) = ix(2,k)
283         ix(2,k) = tt
284         tty = ix(1,l)
285         ix(1,l) = ix(1,k)
286         ix(1,k) = tty
287         go to 130
288      endif
289C
290C     Save upper and lower subscripts of the array yet to be sorted
291C
292      if (l-i .gt. j-k) then
293         il(m) = i
294         iu(m) = l
295         i = k
296         m = m+1
297      else
298         il(m) = k
299         iu(m) = j
300         j = l
301         m = m+1
302      endif
303      go to 160
304C
305C     Begin again on another portion of the unsorted array
306C
307  150 m = m-1
308      if (m .eq. 0) go to 190
309      i = il(m)
310      j = iu(m)
311C
312  160 if (j-i .ge. 1) go to 120
313      if (i .eq. 1) go to 110
314      i = i-1
315C
316  170 i = i+1
317      if (i .eq. j) go to 150
318      t = ix(2,i+1)
319      ty = ix(1,i+1)
320      if (ix(2,i) .le. t) go to 170
321      k = i
322C
323  180 ix(2,k+1) = ix(2,k)
324      ix(1,k+1) = ix(1,k)
325      k = k-1
326      if (t .lt. ix(2,k)) go to 180
327      ix(2,k+1) = t
328      ix(1,k+1) = ty
329      go to 170
330C
331C     Clean up
332C
333  190 if (kflag .le. -1) then
334         do 200 i=1,nn
335            ix(2,i) = -ix(2,i)
336  200    continue
337      endif
338      return
339      end
340