program sort
      integer*4 i,n,n0
      parameter (n0=50000)
      real*8 a(n0),b(n0)
      real*8 ao(n0),bo(n0)
      write(6,*)'Input N:'
      read(5,*)n
      aa=0.0
      do 1 i=1,n
      aa=aa+1.0
      a(i)=sin(aa)
      ao(i)=sin(aa)
      bo(i)=sin(aa)
1     b(i)=sin(aa)
      write(6,600)(a(i),i=1,n)
      write(6,600)(b(i),i=1,n)
600   format(8f10.5)
      write(6,*)'input a key'
      read(5,'(a)')
      write(6,*)'quick starts'
      call sort2(n,a,b)
      write(6,*)'quick ends'
      write(6,*)'buble starts'
      call sort3(n,ao,bo)
      write(6,*)'buble ends'
      write(6,600)(a(i),i=1,n)
      write(6,600)(b(i),i=1,n)
      write(6,600)(ao(i),i=1,n)
      write(6,600)(bo(i),i=1,n)
      stop
      end
c     =========================================================
      subroutine sort3(n,a,b)
c     insertion sort
      integer*4 i,n
      real*8 a(n),b(n)
      do 1 i=1,n-1
3     at=a(i)
      do 2 j=i+1,n
      if(a(j).lt.at)then
        tem=a(j)
        a(j)=a(i)
        a(i)=tem
        tem=b(j)
        b(j)=b(i)
        b(i)=tem
        goto 3
       endif
2      continue
1      continue
       return
       end
c     =========================================================
      subroutine sort2(n,arr,brr)
c     Sorts an array arr(1:n) into ascending order while
c     making rearangement of the array brr(1:n)
c     M ... when buble sort is switched on
c
      integer*4 n,M,nstack
      parameter (M=10,NSTACK=500)
      real*8 arr(N),brr(N),a,b,temp
      integer*4 i,ir,j,jstack,k,l,istack(NSTACK)
      jstack=0
      l=1
      ir=n
1     if(ir-l.lt.M)then
c      insertion sort for small Ms:
       do j=l+1,ir
        a=arr(j)
        b=brr(j)
        do i=j-1,l,-1
         if(arr(i).le.a)goto 2
         arr(i+1)=arr(i)
         brr(i+1)=brr(i)
        enddo
        i=l-1
2       arr(i+1)=a
        brr(i+1)=b
       enddo
       if(jstack.eq.0)return
c      pop stack and begind new round of partitioning
       ir=istack(jstack)
       l=istack(jstack-1)
       jstack=jstack-2
      else
c      choose median of left, center and right elements as partitioning
c      element a. Also rearrange so that a(l)<=a(l+1)<=a(ir)
       k=(l+ir)/2
       temp=arr(k)
       arr(k)=arr(l+1)
       arr(l+1)=temp
       temp=brr(k)
       brr(k)=brr(l+1)
       brr(l+1)=temp
       if(arr(l).gt.arr(ir))then
        temp=arr(l)
        arr(l)=arr(ir)
        arr(ir)=temp
        temp=brr(l)
        brr(l)=brr(ir)
        brr(ir)=temp
       endif
       if(arr(l+1).gt.arr(ir))then
        temp=arr(l+1)
        arr(l+1)=arr(ir)
        arr(ir)=temp
        temp=brr(l+1)
        brr(l+1)=brr(ir)
        brr(ir)=temp
       endif
       if(arr(l).gt.arr(l+1))then
        temp=arr(l)
        arr(l)=arr(l+1)
        arr(l+1)=temp
        temp=brr(l)
        brr(l)=brr(l+1)
        brr(l+1)=temp
       endif
c      initialize pointers for partitioning
       i=l+1
       j=ir
c      partitioning element
       a=arr(l+1)
       b=brr(l+1)
c      beginninf of innermost loop
3      continue
c      scan up to find element >a
       i=i+1
       if(arr(i).lt.a)goto 3
4      continue
c      scan down to find element <a
       j=j-1
       if(arr(j).gt.a)goto 4
c      pointers crossed; exit whe partitioning complete
       if(j.lt.i)goto 5
c      exchange elements of both arrays
       temp=arr(i)
       arr(i)=arr(j)
       arr(j)=temp
       temp=brr(i)
       brr(i)=brr(j)
       brr(j)=temp
       goto 3
c      end of innermost loop
c      insert partitioning elements in both arrays
5      arr(l+1)=arr(j)
       arr(j)=a
       brr(l+1)=brr(j)
       brr(j)=b
       jstack=jstack+2
c      push pointers to larger subarray on stack,
c      process smaller subarray immediately
       if(jstack.gt.nstack)pause 'nstack too small'
       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