WSJT-X/indexx.f
Joe Taylor 2c17544f3f initial import
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/WSJT/trunk@1 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2005-12-22 16:40:53 +00:00

80 lines
1.9 KiB
Fortran

SUBROUTINE indexx(n,arr,indx)
INTEGER n,indx(n),M,NSTACK
REAL arr(n)
PARAMETER (M=7,NSTACK=50)
INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
REAL a
do 11 j=1,n
indx(j)=j
11 continue
jstack=0
l=1
ir=n
1 if(ir-l.lt.M)then
do 13 j=l+1,ir
indxt=indx(j)
a=arr(indxt)
do 12 i=j-1,1,-1
if(arr(indx(i)).le.a)goto 2
indx(i+1)=indx(i)
12 continue
i=0
2 indx(i+1)=indxt
13 continue
if(jstack.eq.0)return
ir=istack(jstack)
l=istack(jstack-1)
jstack=jstack-2
else
k=(l+ir)/2
itemp=indx(k)
indx(k)=indx(l+1)
indx(l+1)=itemp
if(arr(indx(l+1)).gt.arr(indx(ir)))then
itemp=indx(l+1)
indx(l+1)=indx(ir)
indx(ir)=itemp
endif
if(arr(indx(l)).gt.arr(indx(ir)))then
itemp=indx(l)
indx(l)=indx(ir)
indx(ir)=itemp
endif
if(arr(indx(l+1)).gt.arr(indx(l)))then
itemp=indx(l+1)
indx(l+1)=indx(l)
indx(l)=itemp
endif
i=l+1
j=ir
indxt=indx(l)
a=arr(indxt)
3 continue
i=i+1
if(arr(indx(i)).lt.a)goto 3
4 continue
j=j-1
if(arr(indx(j)).gt.a)goto 4
if(j.lt.i)goto 5
itemp=indx(i)
indx(i)=indx(j)
indx(j)=itemp
goto 3
5 indx(l)=indx(j)
indx(j)=indxt
jstack=jstack+2
if(jstack.gt.NSTACK)pause 'NSTACK too small in indexx'
if(ir-i+1.ge.j-l)then
istack(jstack)=ir
istack(jstack-1)=i
ir=j-1
else
istack(jstack)=j-1
istack(jstack-1)=l
l=i
endif
endif
goto 1
END
C (C) Copr. 1986-92 Numerical Recipes Software *(t9,12.