kqsort.f

Go to the documentation of this file.

!
!      call kqsort(compf, idx, n)
!
!      kqsort is a quick sort routine for any data type in a 1 dimensional
!      array.  (data type may be real, integer, character, double precision
!      real or integer, half integer)
!      It can sort the data in ascending or descending order.
!      If you follow the instructions below, you will get ascending sort.
!
!      To use kqsort, you have to supply a simple integer function for each
!      array you want to sort.  The name is arbitrary, and must be like
!      
!      integer  compf
!      external compf
!      --------------------
!      integer  n
!      parameter (n = 10000)
!      real  x(n) 
!      common /abc/ x
!      ------------------- 
!      integer idx(n)
!       
!      x(*)  is computed somewhere
!      call kqsort(compf, idx, n)
!      Then, idx gets sorted order as (in default)
!      x(idx(1)) <= x(idx(2)) <= x(idx(3)).... <= x(idx(n))
!
!    ,,,
!      integer function compf(i, j)
!      integer i, j
!      --------------------
!      integer  n
!      parameter (n = 10000)
!      real  x(n) 
!      common /abc/ x
!      ------------------- 
!       if( x(i) .lt. x(j)) then
!          compf = -1     ! put  1 if you want descending sort
!       elseif( x(i) .gt.  x(j)) then
!          compf = 1      ! put -1 if you want descending sort
!       else
!          compf = 0
!       endif
!       end
!       *******************************************
!      If you want to have descending order, you may use
!      idx(n) to idx(1). However, this may lead to some confusion,
!      so you can get  descening sort directly. There are two method:
!      
!      1) After calling kqsort in a default manner, you may call
!            call ksortinv(idx, n)
!         Then, x(idx(1)) >= x(idx(2)) ... >= x(idx(n)) 
!      2) You may construct compf integer funtcion as shown by the
!         comment in the above example (reverse the sing of the function
!         value).
!
!      You may worry about the overhead of calling ksortinv,
!      but the time for it can  be negligiblly small as compared with
!      kqsort itself.
!
!      If you sort a large array (say, size >10^6)
!      many times, it  may be  better to use
!      kqsortd, kqsortr, kqsoti, kqsorth or kqsortc depending on
!      double precision real, real, integer, half integer, character
!      data. These routines don't require additonal integer function
!      like compf. 
!           call kqsort?(x, idx, n)
!      The routies are for ascending order sort; if you
!      want descending sort, use ksortinv.  
!      ********************
!
!cc       test kqsort
!      implicit none
!      integer i, j 
!      
!      external dcompf, icompf, rcompf, ccompf
!      integer dcompf, icomf, rcompf, ccompf
!      real*8  u
!
!      integer n
!      parameter (n = 1000000)
!      real*8 a( n )
!      real   b( n ) 
!      integer c( n )
!      character*9  x( 10 )
!
!      common /zzz/ a, b, c
!      common /zzzc/ x
!
!      integer idx(n)
!
!      do i = 1, n
!         call rndc(u)
!         b(i) = u
!      enddo
!      call kqsort(rcompf, idx, n)
!      do i = 1, n/2
!         j =idx(i)
!         idx(i) = idx(n-i+1)
!         idx(n-i+1) = j
!      enddo
!                                              
!      do  i=1, 10
!         write(*,*) i, b(idx(i))
!      enddo
!      do i=n-10, n
!         write(*,*) i, b(idx(i))
!      enddo
!
!
!      end
!
!
!      integer function dcompf(i, j)
!      integer i, j
!      integer n
!      parameter (n = 1000000)
!      real*8 a( n )
!      real   b( n ) 
!      integer c( n )
!      character*9  x(  10 )
!      common /zzz/ a, b, c
!      common /zzzc/ x
!
!      
!      if(a(i) .lt. a(j)) then
!         dcompf = -1
!      elseif(a(i) .eq. a(j)) then
!         dcompf = 0
!      else
!         dcompf = 1
!      endif
!      end
!      integer function rcompf(i, j)
!      integer i, j
!      integer n
!      parameter (n = 1000000)
!      real*8 a( n )
!      real   b( n ) 
!      integer c( n )
!      character*9  x(  10 )
!      common /zzz/ a, b, c
!      common /zzzc/ x
!
!      
!      if(b(i) .lt. b(j)) then
!         rcompf = -1
!      elseif(b(i) .eq. b(j)) then
!         rcompf = 0
!      else
!         rcompf = 1
!      endif
!      end
!
!      integer function icompf(i, j)
!      integer i, j
!      integer n
!      parameter (n = 1000000)
!      real*8 a( n )
!      real   b( n ) 
!      integer c( n )
!      character*9  x(  10 )
!      common /zzz/ a, b, c
!      common /zzzc/ x
!
!      
!      if(c(i) .lt. c(j)) then
!         icompf = -1
!      elseif(c(i) .eq. c(j)) then
!         icompf = 0
!      else
!         icompf = 1
!      endif
!      end
!
!      integer function ccompf(i, j)
!      integer i, j
!      integer n
!      parameter (n = 1000000)
!      real*8 a( n )
!      real   b( n ) 
!      integer c( n )
!      character*9  x( 10 )
!      common /zzz/ a, b, c
!      common /zzzc/ x
!
!      
!      if(x(i) .lt. x(j)) then
!         ccompf = -1
!      elseif(x(i) .eq. x(j)) then
!         ccompf = 0
!      else
!         ccompf = 1
!      endif
!      end
!      
      SUBROUTINE kqsort(compf, ORD,N)
!
!==============SORTS THE ARRAY A(I),I=1,2,...,N BY PUTTING THE
!   ASCENDING ORDER VECTOR IN ORD.  THAT IS ASCENDING ORDERED A
!   IS A(ORD(I)),I=1,2,...,N; DESCENDING ORDER A IS A(ORD(N-I+1)),
!   I=1,2,...,N .  THIS SORT RUNS IN TIME PROPORTIONAL TO N LOG N .
!
!
!     ACM QUICKSORT - ALGORITHM #402 - IMPLEMENTED IN FORTRAN BY
!                                 WILLIAM H. VERITY
!                                 COMPUTATION CENTER
!                                 PENNSYLVANIA STATE UNIVERSITY
!                                 UNIVERSITY PARK, PA.  16802
!
      IMPLICIT INTEGER (A-Z)
!
      dimension ord(n),poplst(2,20)
      external compf
!c      INTEGER X,XX,Z,ZZ,Y
!c      CHARACTER *(*) A(N)
!
      ndeep=0
      u1=n
      l1=1
      DO 1  i=1,n
    1 ord(i)=i
    2 IF (u1.GT.l1) GO TO 3
      RETURN
!
    3 l=l1
      u=u1
!
! PART
!
    4 p=l
      q=u
      x=ord(p)
      z=ord(q)

!      IF (A(X).LE.A(Z)) GO TO 5
      if( compf(x, z) .le. 0 ) goto 5 
      y=x
      x=z
      z=y
      yp=ord(p)
      ord(p)=ord(q)
      ord(q)=yp
    5 IF (u-l.LE.1) GO TO 15
      xx=x
      ix=p
      zz=z
      iz=q
!
! LEFT
!
    6 p=p+1
      IF (p.GE.q) GO TO 7
      x=ord(p)
!      IF (A(X).GE.A(XX)) GO TO 8
      if( compf(x, xx) .ge. 0) goto 8
      GO TO 6
    7 p=q-1
      GO TO 13
!
! RIGHT
!
    8 q=q-1
      IF (q.LE.p) GO TO 9
      z=ord(q)
!      IF (A(Z).LE.A(ZZ)) GO TO 10
      if( compf(z, zz) .le. 0)   goto 10
      GO TO 8
    9 q=p
      p=p-1
      z=x
      x=ord(p)
!
! DIST
!
!   10 IF (A(X).LE.A(Z)) GO TO 11
 10   IF ( compf(x, z) .le. 0) goto 11  
      y=x
      x=z
      z=y
      ip=ord(p)
      ord(p)=ord(q)
      ord(q)=ip
!   11 IF (A(X).LE.A(XX)) GO TO 12
   11 IF ( compf( x, xx) .le. 0) goto 12
      xx=x
      ix=p
!   12 IF (A(Z).GE.A(ZZ)) GO TO 6
   12 IF ( compf(z, zz) .ge. 0) goto 6
      zz=z
      iz=q
      GO TO 6
!
! OUT
!
   13 CONTINUE
!      IF (.NOT.(P.NE.IX.AND.A(X).NE.A(XX))) GO TO 14
      IF (.NOT.(p.NE.ix.AND. compf(x, xx) .ne. 0) ) goto 14
      ip=ord(p)
      ord(p)=ord(ix)
      ord(ix)=ip
   14 CONTINUE
!      IF (.NOT.(Q.NE.IZ.AND.A(Z).NE.A(ZZ))) GO TO 15
      IF (.NOT.(q.NE.iz.AND. compf(z, zz) .ne. 0) ) goto 15
      iq=ord(q)
      ord(q)=ord(iz)
      ord(iz)=iq
   15 CONTINUE
      IF (u-q.LE.p-l) GO TO 16
      l1=l
      u1=p-1
      l=q+1
      GO TO 17
   16 u1=u
      l1=q+1
      u=p-1
   17 CONTINUE
      IF (u1.LE.l1) GO TO 18
!
! START RECURSIVE CALL
!
      ndeep=ndeep+1
      poplst(1,ndeep)=u
      poplst(2,ndeep)=l
      GO TO 3
   18 IF (u.GT.l) GO TO 4
!
! POP BACK UP IN THE RECURSION LIST
!
      IF (ndeep.EQ.0) GO TO 2
      u=poplst(1,ndeep)
      l=poplst(2,ndeep)
      ndeep=ndeep-1
      GO TO 18
!
! END SORT
! END QSORT
!
      END