b903862bf662ec3183013c96e075aeb9991aa8c9
[unres.git] / source / unres / src_MD / indexx.f
1       SUBROUTINE indexx(n,arr,indx)
2       implicit real*8 (a-h,o-z)
3       INTEGER n,indx(n),M,NSTACK
4       REAL*8 arr(n)
5 c     PARAMETER (M=7,NSTACK=50)
6       PARAMETER (M=7,NSTACK=500)
7       INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
8       REAL*8 a
9       do 11 j=1,n
10         indx(j)=j
11 11    continue
12       jstack=0
13       l=1
14       ir=n
15 1     if(ir-l.lt.M)then
16         do 13 j=l+1,ir
17           indxt=indx(j)
18           a=arr(indxt)
19           do 12 i=j-1,1,-1
20             if(arr(indx(i)).le.a)goto 2
21             indx(i+1)=indx(i)
22 12        continue
23           i=0
24 2         indx(i+1)=indxt
25 13      continue
26         if(jstack.eq.0)return
27         ir=istack(jstack)
28         l=istack(jstack-1)
29         jstack=jstack-2
30       else
31         k=(l+ir)/2
32         itemp=indx(k)
33         indx(k)=indx(l+1)
34         indx(l+1)=itemp
35         if(arr(indx(l+1)).gt.arr(indx(ir)))then
36           itemp=indx(l+1)
37           indx(l+1)=indx(ir)
38           indx(ir)=itemp
39         endif
40         if(arr(indx(l)).gt.arr(indx(ir)))then
41           itemp=indx(l)
42           indx(l)=indx(ir)
43           indx(ir)=itemp
44         endif
45         if(arr(indx(l+1)).gt.arr(indx(l)))then
46           itemp=indx(l+1)
47           indx(l+1)=indx(l)
48           indx(l)=itemp
49         endif
50         i=l+1
51         j=ir
52         indxt=indx(l)
53         a=arr(indxt)
54 3       continue
55           i=i+1
56         if(arr(indx(i)).lt.a)goto 3
57 4       continue
58           j=j-1
59         if(arr(indx(j)).gt.a)goto 4
60         if(j.lt.i)goto 5
61         itemp=indx(i)
62         indx(i)=indx(j)
63         indx(j)=itemp
64         goto 3
65 5       indx(l)=indx(j)
66         indx(j)=indxt
67         jstack=jstack+2
68         if(jstack.gt.NSTACK)pause 'NSTACK too small in indexx'
69         if(ir-i+1.ge.j-l)then
70           istack(jstack)=ir
71           istack(jstack-1)=i
72           ir=j-1
73         else
74           istack(jstack)=j-1
75           istack(jstack-1)=l
76           l=i
77         endif
78       endif
79       goto 1
80       END
81 C  (C) Copr. 1986-92 Numerical Recipes Software *11915aZ%.