      subroutine heapsort(n,x) ! bernd berg june 19 1999.
      include '../../libs/fortran/implicit.sta'
      dimension x(n)
c
c building the heap:
c ==================
      nhalf=n/2
      do m=nhalf,1,-1
        temp=x(m) 
        i1=m
        i2=m+m
1       continue
c         index the larger of x(i2) and x(i2+1) as i2:
          if(i2.lt.n) then
            if(x(i2+1).gt.x(i2)) i2=i2+1
          endif
          if(x(i2).gt.temp) then 
            x(i1)=x(i2)
            i1=i2
            i2=i1+i1
          else  
            i2=n+1
          endif
        if(i2.le.n) go to 1
        x(i1)=temp ! final position for temp=x(m).
      enddo
c
c sorting the heap:
c =================
      do i=n,3,-1 ! i is the number of still competing elements.
        temp=x(i)
        x(i)=x(1) ! store top of the heap.
        i1=1
        i2=2
2       continue
c         index the larger of x(i2) and x(i2+1) as i2:
          if((i2+1).lt.i) then
            if(x(i2+1).gt.x(i2)) i2=i2+1
          endif
          if(x(i2).gt.temp) then  
            x(i1)=x(i2)
            i1=i2
            i2=i1+i1
          else 
            i2=i
          endif 
        if(i2.lt.i) go to 2
        x(i1)=temp ! final position for temp=x(i).
      enddo 
      temp=x(2)
      x(2)=x(1)
      x(1)=temp
      return
      end
