mirror of https://github.com/saitohirga/WSJT-X.git
97 lines
1.6 KiB
Fortran
97 lines
1.6 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
|
|
n0=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(i.gt.n0) then
|
|
do jj=1,n0
|
|
write(99,3001) jj,arr(jj),i,n,ir
|
|
3001 format(i10,e12.3,3i10)
|
|
enddo
|
|
close(99)
|
|
stop 'Bounds error in sort.f90'
|
|
endif
|
|
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
|