← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/calelm/dsort.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/calelm/dsort.f
 
1
C/MEMBR ADD NAME=DSORT,SSI=0
 
2
c     Copyright INRIA
 
3
      subroutine dsort(count,n,index)
 
4
c
 
5
c!purpose
 
6
c     dsort sort double precision array,maintaining an index array
 
7
c
 
8
c!calling sequence
 
9
c     subroutine dsort(count,n,index)
 
10
c     integer n,index(n)
 
11
c     double precision count(n)
 
12
c
 
13
c     count   : array to be sorted
 
14
c     n       :size of count and index
 
15
c     index   : array containing on return index of sorted array
 
16
c
 
17
c!method
 
18
c     quick sort metjod is used
 
19
c!restriction
 
20
c     n must be less than 2**(50/2) ! due to lengh of work space mark
 
21
c!
 
22
      dimension mark(50),index(n)
 
23
      double precision count(n),av,x
 
24
c  set index array to original order .
 
25
      do 10 i=1,n
 
26
      index(i)=i
 
27
   10 continue
 
28
c  check that a trivial case has not been entered .
 
29
      if(n.eq.1)goto 200
 
30
      if(n.ge.1)go to 30
 
31
      goto 200
 
32
c  'm' is the length of segment which is short enough to enter
 
33
c  the final sorting routine. it may be easily changed.
 
34
   30 m=12
 
35
c  set up initial values.
 
36
      la=2
 
37
      is=1
 
38
      if=n
 
39
      do 190 mloop=1,n
 
40
c  if segment is short enough sort with final sorting routine .
 
41
      ifka=if-is
 
42
      if((ifka+1).gt.m)goto 70
 
43
c********* final sorting ***
 
44
c  ( a simple bubble sort )
 
45
      is1=is+1
 
46
      do 60 j=is1,if
 
47
      i=j
 
48
   40 if(count(i-1).gt.count(i))goto 60
 
49
      if(count(i-1).lt.count(i))goto 50
 
50
      if(index(i-1).lt.index(i))goto 60
 
51
   50 av=count(i-1)
 
52
      count(i-1)=count(i)
 
53
      count(i)=av
 
54
      int=index(i-1)
 
55
      index(i-1)=index(i)
 
56
      index(i)=int
 
57
      i=i-1
 
58
      if(i.gt.is)goto  40
 
59
   60 continue
 
60
      la=la-2
 
61
      goto 170
 
62
c             *******  quicksort  ********
 
63
c  select the number in the central position in the segment as
 
64
c  the test number.replace it with the number from the segment's
 
65
c  highest address.
 
66
   70 iy=(is+if)/2
 
67
      x=count(iy)
 
68
      intest=index(iy)
 
69
      count(iy)=count(if)
 
70
      index(iy)=index(if)
 
71
c  the markers 'i' and 'ifk' are used for the beginning and end
 
72
c  of the section not so far tested against the present value
 
73
c  of x .
 
74
      k=1
 
75
      ifk=if
 
76
c  we alternate between the outer loop that increases i and the
 
77
c  inner loop that reduces ifk, moving numbers and indices as
 
78
c  necessary, until they meet .
 
79
      do 110 i=is,if
 
80
      if(x.lt.count(i))goto 110
 
81
      if(x.gt.count(i))goto 80
 
82
      if(intest.gt.index(i))goto 110
 
83
   80 if(i.ge.ifk)goto 120
 
84
      count(ifk)=count(i)
 
85
      index(ifk)=index(i)
 
86
      k1=k
 
87
      do 100 k=k1,ifka
 
88
      ifk=if-k
 
89
      if(count(ifk).lt.x)goto 100
 
90
      if(count(ifk).gt.x)goto 90
 
91
      if(intest.le.index(ifk))goto 100
 
92
   90 if(i.ge.ifk)goto 130
 
93
      count(i)=count(ifk)
 
94
      index(i)=index(ifk)
 
95
      go to 110
 
96
  100 continue
 
97
      goto 120
 
98
  110 continue
 
99
c  return the test number to the position marked by the marker
 
100
c  which did not move last. it divides the initial segment into
 
101
c  2 parts. any element in the first part is less than or equal
 
102
c  to any element in the second part, and they may now be sorted
 
103
c  independently .
 
104
  120 count(ifk)=x
 
105
      index(ifk)=intest
 
106
      ip=ifk
 
107
      goto 140
 
108
  130 count(i)=x
 
109
      index(i)=intest
 
110
      ip=i
 
111
c  store the longer subdivision in workspace.
 
112
  140 if((ip-is).gt.(if-ip))goto 150
 
113
      mark(la)=if
 
114
      mark(la-1)=ip+1
 
115
      if=ip-1
 
116
      goto 160
 
117
  150 mark(la)=ip-1
 
118
      mark(la-1)=is
 
119
      is=ip+1
 
120
c  find the length of the shorter subdivision.
 
121
  160 lngth=if-is
 
122
      if(lngth.le.0)goto 180
 
123
c  if it contains more than one element supply it with workspace .
 
124
      la=la+2
 
125
      goto 190
 
126
  170 if(la.le.0)goto 200
 
127
c  obtain the address of the shortest segment awaiting quicksort
 
128
  180 if=mark(la)
 
129
      is=mark(la-1)
 
130
  190 continue
 
131
  200 return
 
132
      end