subroutine r4_sort(x,ilist,partno,n)

c THIS SUBROUTINE SORTS A LIST OF NUMBERS, X.  ILIST IS THE FINAL POSTION
C IN THE LIST THAT EACH NUMBER OCCUPIES AFTER SORTING AND CAN BE USED AS
C A PERMUTE ADDRESS FOR OTHER DATA.

      real * 4 x(n)
      real * 4 xt(n)
      real * 4 xo(n)
      real * 4 size,xmax,xmin

      integer * 4 partno(n)
      integer * 4 itemp((50*n)+1),ilist(n),ilistt(n),ix(n),iflag(n)
      
      xmax=maxval(x)
      xmin=minval(x)
      
      size=(xmax-xmin)/(50*n)
      
      ix=int((x-xmin)/size)+1

      iflag=0
      itemp=0
      
      itemp(ix)=partno
      
      where (itemp.gt.0) iflag(itemp)=1

      j=1

      do while (any(iflag.eq.0))

         where (iflag.eq.0.and.ix+j.le.n.and.itemp(ix+j).eq.0)
            itemp(ix+j)=partno
         end where
         
         where (itemp.gt.0) iflag(itemp)=1

         where (iflag.eq.0.and.ix-j.ge.1.and.itemp(ix-j).eq.0)
            itemp(ix-j)=partno
         end where

         where (itemp.gt.0) iflag(itemp)=1
	
         j=j+1
	
      end do

      ilist=pack(itemp,mask=itemp.gt.0,vector=ilist)

      x=x(ilist)


c bubble sort to finish

      xt=x
      ilistt=ilist
      
      where (partno.gt.1) 
         xo=-1.0
      elsewhere
         xo=1.0
      end where

      j=0

      do while (any(xo.lt.0))
         
         where (partno.ne.1) xo=x-x(partno-1)

         where (xo.lt.0.0.and.xo(partno-1).ge.0.0)
         
            x(partno-1)=x
            x=xt(partno-1)
            ilist(partno-1)=ilist
            ilist=ilistt(partno-1)
            
	end where

        xt=x
        ilistt=ilist

        j=j+1

      end do

      return
      end