source/unres/src_CSA/indexx.f

   1       SUBROUTINE indexx(n,arr,indx)
   2       implicit real*8 (a-h,o-z)
   3       INTEGER n,indx(n),M,NSTACK
   4       REAL*8 arr(n)
   5 c     PARAMETER (M=7,NSTACK=50)
   6       PARAMETER (M=7,NSTACK=500)
   7       INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
   8       REAL*8 a
   9       do 11 j=1,n
  10         indx(j)=j
  11 11    continue
  12       jstack=0
  13       l=1
  14       ir=n
  15 1     if(ir-l.lt.M)then
  16         do 13 j=l+1,ir
  17           indxt=indx(j)
  18           a=arr(indxt)
  19           do 12 i=j-1,1,-1
  20             if(arr(indx(i)).le.a)goto 2
  21             indx(i+1)=indx(i)
  22 12        continue
  23           i=0
  24 2         indx(i+1)=indxt
  25 13      continue
  26         if(jstack.eq.0)return
  27         ir=istack(jstack)
  28         l=istack(jstack-1)
  29         jstack=jstack-2
  30       else
  31         k=(l+ir)/2
  32         itemp=indx(k)
  33         indx(k)=indx(l+1)
  34         indx(l+1)=itemp
  35         if(arr(indx(l+1)).gt.arr(indx(ir)))then
  36           itemp=indx(l+1)
  37           indx(l+1)=indx(ir)
  38           indx(ir)=itemp
  39         endif
  40         if(arr(indx(l)).gt.arr(indx(ir)))then
  41           itemp=indx(l)
  42           indx(l)=indx(ir)
  43           indx(ir)=itemp
  44         endif
  45         if(arr(indx(l+1)).gt.arr(indx(l)))then
  46           itemp=indx(l+1)
  47           indx(l+1)=indx(l)
  48           indx(l)=itemp
  49         endif
  50         i=l+1
  51         j=ir
  52         indxt=indx(l)
  53         a=arr(indxt)
  54 3       continue
  55           i=i+1
  56         if(arr(indx(i)).lt.a)goto 3
  57 4       continue
  58           j=j-1
  59         if(arr(indx(j)).gt.a)goto 4
  60         if(j.lt.i)goto 5
  61         itemp=indx(i)
  62         indx(i)=indx(j)
  63         indx(j)=itemp
  64         goto 3
  65 5       indx(l)=indx(j)
  66         indx(j)=indxt
  67         jstack=jstack+2
  68         if(jstack.gt.NSTACK)pause 'NSTACK too small in indexx'
  69         if(ir-i+1.ge.j-l)then
  70           istack(jstack)=ir
  71           istack(jstack-1)=i
  72           ir=j-1
  73         else
  74           istack(jstack)=j-1
  75           istack(jstack-1)=l
  76           l=i
  77         endif
  78       endif
  79       goto 1
  80       END
  81 C  (C) Copr. 1986-92 Numerical Recipes Software *11915aZ%.