mirror of https://github.com/pavel-demin/ft8d.git
92 lines
1.6 KiB
Fortran
92 lines
1.6 KiB
Fortran
subroutine indexx(arr,n,indx)
|
|
|
|
parameter (M=7,NSTACK=50)
|
|
integer n,indx(n)
|
|
real arr(n)
|
|
integer i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
|
|
real a
|
|
|
|
do j=1,n
|
|
indx(j)=j
|
|
enddo
|
|
|
|
jstack=0
|
|
l=1
|
|
ir=n
|
|
1 if(ir-l.lt.M) then
|
|
do j=l+1,ir
|
|
indxt=indx(j)
|
|
a=arr(indxt)
|
|
do i=j-1,1,-1
|
|
if(arr(indx(i)).le.a) goto 2
|
|
indx(i+1)=indx(i)
|
|
enddo
|
|
i=0
|
|
2 indx(i+1)=indxt
|
|
enddo
|
|
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) stop '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 subroutine indexx
|
|
|