WSJT-X/lib/sort.f90
Joe Taylor d91aed5aee Improved, simplified sort routine; faster and better "flatten"
procedure; better window functions for some FFTs, resulting in
better decoder performance; User-selectable colors for backgrounds
of decoded messages.  NB: more testing is desirable!



git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@4951 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2015-02-11 00:50:35 +00:00

88 lines
1.4 KiB
Fortran

subroutine sort(n,arr)
integer n,m,nstack
real arr(n)
parameter (m=7,nstack=50)
integer i,ir,j,jstack,k,l,istack(nstack)
real a,temp
jstack=0
l=1
ir=n
1 if(ir-l.lt.m) then
do j=l+1,ir
a=arr(j)
do i=j-1,1,-1
if(arr(i).le.a) goto 2
arr(i+1)=arr(i)
enddo
i=0
2 arr(i+1)=a
enddo
if(jstack.eq.0) return
ir=istack(jstack)
l=istack(jstack-1)
jstack=jstack-2
else
k=(l+ir)/2
temp=arr(k)
arr(k)=arr(l+1)
arr(l+1)=temp
if(arr(l+1).gt.arr(ir)) then
temp=arr(l+1)
arr(l+1)=arr(ir)
arr(ir)=temp
endif
if(arr(l).gt.arr(ir)) then
temp=arr(l)
arr(l)=arr(ir)
arr(ir)=temp
endif
if(arr(l+1).gt.arr(l)) then
temp=arr(l+1)
arr(l+1)=arr(l)
arr(l)=temp
endif
i=l+1
j=ir
a=arr(l)
3 i=i+1
if(arr(i).lt.a) goto 3
4 j=j-1
if(arr(j).gt.a) goto 4
if(j.lt.i) goto 5
temp=arr(i)
arr(i)=arr(j)
arr(j)=temp
goto 3
5 arr(l)=arr(j)
arr(j)=a
jstack=jstack+2
if(jstack.gt.nstack) stop 'nstack too small in sort'
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 sort