← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to routines/arpack/dsesrt.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

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