← Back to branch summary

~ubuntu-branches/ubuntu/saucy/python-scipy/saucy

« back to all changes in this revision

Viewing changes to Lib/sandbox/arpack/ARPACK/SRC/ssortr.f

  • Committer: Bazaar Package Importer
  • Author(s): Ondrej Certik
  • Date: 2008-06-16 22:58:01 UTC
  • mfrom: (2.1.24 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080616225801-irdhrpcwiocfbcmt
Tags: 0.6.0-12
http://bugs.debian.org/489149
* The description updated to match the current SciPy (Closes: #489149).
* Standards-Version bumped to 3.8.0 (no action needed)
* Build-Depends: netcdf-dev changed to libnetcdf-dev

Show diffs side-by-side

added added

removed removed

Lines of Context:
Lib/sandbox/arpack/ARPACK/SRC/ssortr.f
1
 
c-----------------------------------------------------------------------
2
 
c\BeginDoc
3
 
c
4
 
c\Name: ssortr
5
 
c
6
 
c\Description:
7
 
c  Sort the array X1 in the order specified by WHICH and optionally 
8
 
c  applies the permutation to the array X2.
9
 
c
10
 
c\Usage:
11
 
c  call ssortr
12
 
c     ( WHICH, APPLY, N, X1, X2 )
13
 
c
14
 
c\Arguments
15
 
c  WHICH   Character*2.  (Input)
16
 
c          'LM' -> X1 is sorted into increasing order of magnitude.
17
 
c          'SM' -> X1 is sorted into decreasing order of magnitude.
18
 
c          'LA' -> X1 is sorted into increasing order of algebraic.
19
 
c          'SA' -> X1 is sorted into decreasing order of algebraic.
20
 
c
21
 
c  APPLY   Logical.  (Input)
22
 
c          APPLY = .TRUE.  -> apply the sorted order to X2.
23
 
c          APPLY = .FALSE. -> do not apply the sorted order to X2.
24
 
c
25
 
c  N       Integer.  (INPUT)
26
 
c          Size of the arrays.
27
 
c
28
 
c  X1      Real array of length N.  (INPUT/OUTPUT)
29
 
c          The array to be sorted.
30
 
c
31
 
c  X2      Real array of length N.  (INPUT/OUTPUT)
32
 
c          Only referenced if APPLY = .TRUE.
33
 
c
34
 
c\EndDoc
35
 
c
36
 
c-----------------------------------------------------------------------
37
 
c
38
 
c\BeginLib
39
 
c
40
 
c\Author
41
 
c     Danny Sorensen               Phuong Vu
42
 
c     Richard Lehoucq              CRPC / Rice University 
43
 
c     Dept. of Computational &     Houston, Texas 
44
 
c     Applied Mathematics
45
 
c     Rice University           
46
 
c     Houston, Texas            
47
 
c
48
 
c\Revision history:
49
 
c     12/16/93: Version ' 2.1'.
50
 
c               Adapted from the sort routine in LANSO.
51
 
c
52
 
c\SCCS Information: @(#) 
53
 
c FILE: sortr.F   SID: 2.3   DATE OF SID: 4/19/96   RELEASE: 2
54
 
c
55
 
c\EndLib
56
 
c
57
 
c-----------------------------------------------------------------------
58
 
c
59
 
      subroutine ssortr (which, apply, n, x1, x2)
60
 
c
61
 
c     %------------------%
62
 
c     | Scalar Arguments |
63
 
c     %------------------%
64
 
c
65
 
      character*2 which
66
 
      logical    apply
67
 
      integer    n
68
 
c
69
 
c     %-----------------%
70
 
c     | Array Arguments |
71
 
c     %-----------------%
72
 
c
73
 
      Real
74
 
     &           x1(0:n-1), x2(0:n-1)
75
 
c
76
 
c     %---------------%
77
 
c     | Local Scalars |
78
 
c     %---------------%
79
 
c
80
 
      integer    i, igap, j
81
 
      Real
82
 
     &           temp
83
 
c
84
 
c     %-----------------------%
85
 
c     | Executable Statements |
86
 
c     %-----------------------%
87
 
c
88
 
      igap = n / 2
89
 
c 
90
 
      if (which .eq. 'SA') then
91
 
c
92
 
c        X1 is sorted into decreasing order of algebraic.
93
 
c
94
 
   10    continue
95
 
         if (igap .eq. 0) go to 9000
96
 
         do 30 i = igap, n-1
97
 
            j = i-igap
98
 
   20       continue
99
 
c
100
 
            if (j.lt.0) go to 30
101
 
c
102
 
            if (x1(j).lt.x1(j+igap)) then
103
 
               temp = x1(j)
104
 
               x1(j) = x1(j+igap)
105
 
               x1(j+igap) = temp
106
 
               if (apply) then
107
 
                  temp = x2(j)
108
 
                  x2(j) = x2(j+igap)
109
 
                  x2(j+igap) = temp
110
 
               end if
111
 
            else
112
 
               go to 30
113
 
            endif
114
 
            j = j-igap
115
 
            go to 20
116
 
   30    continue
117
 
         igap = igap / 2
118
 
         go to 10
119
 
c
120
 
      else if (which .eq. 'SM') then
121
 
c
122
 
c        X1 is sorted into decreasing order of magnitude.
123
 
c
124
 
   40    continue
125
 
         if (igap .eq. 0) go to 9000
126
 
         do 60 i = igap, n-1
127
 
            j = i-igap
128
 
   50       continue
129
 
c
130
 
            if (j.lt.0) go to 60
131
 
c
132
 
            if (abs(x1(j)).lt.abs(x1(j+igap))) then
133
 
               temp = x1(j)
134
 
               x1(j) = x1(j+igap)
135
 
               x1(j+igap) = temp
136
 
               if (apply) then
137
 
                  temp = x2(j)
138
 
                  x2(j) = x2(j+igap)
139
 
                  x2(j+igap) = temp
140
 
               end if
141
 
            else
142
 
               go to 60
143
 
            endif
144
 
            j = j-igap
145
 
            go to 50
146
 
   60    continue
147
 
         igap = igap / 2
148
 
         go to 40
149
 
c
150
 
      else if (which .eq. 'LA') then
151
 
c
152
 
c        X1 is sorted into increasing order of algebraic.
153
 
c
154
 
   70    continue
155
 
         if (igap .eq. 0) go to 9000
156
 
         do 90 i = igap, n-1
157
 
            j = i-igap
158
 
   80       continue
159
 
c
160
 
            if (j.lt.0) go to 90
161
 
c           
162
 
            if (x1(j).gt.x1(j+igap)) then
163
 
               temp = x1(j)
164
 
               x1(j) = x1(j+igap)
165
 
               x1(j+igap) = temp
166
 
               if (apply) then
167
 
                  temp = x2(j)
168
 
                  x2(j) = x2(j+igap)
169
 
                  x2(j+igap) = temp
170
 
               end if
171
 
            else
172
 
               go to 90
173
 
            endif
174
 
            j = j-igap
175
 
            go to 80
176
 
   90    continue
177
 
         igap = igap / 2
178
 
         go to 70
179
 
c 
180
 
      else if (which .eq. 'LM') then
181
 
c
182
 
c        X1 is sorted into increasing order of magnitude.
183
 
c
184
 
  100    continue
185
 
         if (igap .eq. 0) go to 9000
186
 
         do 120 i = igap, n-1
187
 
            j = i-igap
188
 
  110       continue
189
 
c
190
 
            if (j.lt.0) go to 120
191
 
c
192
 
            if (abs(x1(j)).gt.abs(x1(j+igap))) then
193
 
               temp = x1(j)
194
 
               x1(j) = x1(j+igap)
195
 
               x1(j+igap) = temp
196
 
               if (apply) then
197
 
                  temp = x2(j)
198
 
                  x2(j) = x2(j+igap)
199
 
                  x2(j+igap) = temp
200
 
               end if
201
 
            else
202
 
               go to 120
203
 
            endif
204
 
            j = j-igap
205
 
            go to 110
206
 
  120    continue
207
 
         igap = igap / 2
208
 
         go to 100
209
 
      end if
210
 
c
211
 
 9000 continue
212
 
      return
213
 
c
214
 
c     %---------------%
215
 
c     | End of ssortr |
216
 
c     %---------------%
217
 
c
218
 
      end