home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG049.ARK / SORTI.FOR < prev    next >
Text File  |  1984-04-29  |  2KB  |  95 lines
  1.       programsortt
  2.       dimensionindex(64),it(8),kar(64)
  3.       write(3,5)
  4. 5     format(1x,23hHow many shall we sort?)
  5.       read(3,10)n
  6. 10    format(i2)
  7.       do 23000i=1,n
  8.       kar(i)=(sin(float(i))+1.)*16384.
  9. 23000 continue
  10. 23001 continue
  11.       callsorti(kar,index,n)
  12.       write(3,20)
  13. 20    format(1x,18hIndexed test array)
  14.       do 23002i=1,n,8
  15.       do 23004j=1,8
  16.       ji=i+j-1
  17.       ixj=index(ji)
  18.       it(j)=kar(ixj)
  19. 23004 continue
  20. 23005 continue
  21.       write(3,30)it
  22. 23002 continue
  23. 23003 continue
  24. 30    format(8i6)
  25.       stop
  26.       end
  27.       subroutinesorti(a,ix,n)
  28.       dimensiona(n),ix(n),i(13),l(13)
  29.       integera
  30.       do 23006j=1,n
  31.       ix(j)=j
  32. 23006 continue
  33. 23007 continue
  34.       m=1
  35.       i(1)=1
  36.       l(1)=n
  37.       continue
  38. 23008 continue
  39.       im=i(m)
  40.       j=im
  41.       k=l(m)+1
  42.       if(.not.(k.lt.j+2))goto 23011
  43.       m=m-1
  44.       goto 23012
  45. 23011 continue
  46.       ixim=ix(j)
  47.       continue
  48. 23013 continue
  49.       j1=j+1
  50.       k1=k-1
  51.       do 23016j=j1,k1
  52.       ixj=ix(j)
  53.       if(.not.(a(ixim).lt.a(ixj)))goto 23018
  54.       goto120
  55. 23018 continue
  56. 23016 continue
  57. 23017 continue
  58.       goto 23015
  59. 120   continue
  60. 23020 continue
  61.       k=k-1
  62.       ixk=ix(k)
  63. 23021 if(.not.(a(ixim).ge.a(ixk)))goto 23020
  64. 23022 continue
  65.       k=max0(k,j)
  66.       if(.not.(k.eq.j))goto 23023
  67.       goto 23015
  68. 23023 continue
  69.       it=ix(j)
  70.       ix(j)=ix(k)
  71.       ix(k)=it
  72. 23014 goto 23013
  73. 23015 continue
  74.       ix(im)=ix(k-1)
  75.       ix(k-1)=ixim
  76.       if(.not.(k*2-l(m)-im.lt.2))goto 23025
  77.       i(m+1)=im
  78.       i(m)=k
  79.       l(m+1)=k-2
  80.       goto 23026
  81. 23025 continue
  82.       i(m+1)=k
  83.       l(m+1)=l(m)
  84.       l(m)=k-2
  85. 23026 continue
  86.       m=m+1
  87.       if(.not.(m.gt.13))goto 23027
  88.       write(3,90)
  89. 23027 continue
  90. 90    format(1x,45hNumber of segments in quicksort exceeds MAXM )
  91. 23012 continue
  92. 23009 if(.not.(m.lt.1.or.m.gt.13))goto 23008
  93. 23010 continue
  94.       return
  95.       end