1
c-----------------------------------------------------------------------
7
c Sorts the complex array in XREAL and XIMAG into the order
8
c specified by WHICH and optionally applies the permutation to the
9
c real array Y. It is assumed that if an element of XIMAG is
10
c nonzero, then its negative is also an element. In other words,
11
c both members of a complex conjugate pair are to be sorted and the
12
c pairs are kept adjacent to each other.
16
c ( WHICH, APPLY, N, XREAL, XIMAG, Y )
19
c WHICH Character*2. (Input)
20
c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude.
21
c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude.
22
c 'LR' -> sort XREAL into increasing order of algebraic.
23
c 'SR' -> sort XREAL into decreasing order of algebraic.
24
c 'LI' -> sort XIMAG into increasing order of magnitude.
25
c 'SI' -> sort XIMAG into decreasing order of magnitude.
26
c NOTE: If an element of XIMAG is non-zero, then its negative
29
c APPLY Logical. (Input)
30
c APPLY = .TRUE. -> apply the sorted order to array Y.
31
c APPLY = .FALSE. -> do not apply the sorted order to array Y.
36
c XREAL, Double precision array of length N. (INPUT/OUTPUT)
37
c XIMAG Real and imaginary part of the array to be sorted.
39
c Y Double precision array of length N. (INPUT/OUTPUT)
43
c-----------------------------------------------------------------------
48
c Danny Sorensen Phuong Vu
49
c Richard Lehoucq CRPC / Rice University
50
c Dept. of Computational & Houston, Texas
56
c xx/xx/92: Version ' 2.1'
57
c Adapted from the sort routine in LANSO.
59
c\SCCS Information: @(#)
60
c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
64
c-----------------------------------------------------------------------
66
subroutine dsortc (which, apply, n, xreal, ximag, y)
68
c %------------------%
69
c | Scalar Arguments |
70
c %------------------%
81
& xreal(0:n-1), ximag(0:n-1), y(0:n-1)
91
c %--------------------%
92
c | External Functions |
93
c %--------------------%
99
c %-----------------------%
100
c | Executable Statements |
101
c %-----------------------%
105
if (which .eq. 'LM') then
107
c %------------------------------------------------------%
108
c | Sort XREAL,XIMAG into increasing order of magnitude. |
109
c %------------------------------------------------------%
112
if (igap .eq. 0) go to 9000
120
temp1 = dlapy2(xreal(j),ximag(j))
121
temp2 = dlapy2(xreal(j+igap),ximag(j+igap))
123
if (temp1.gt.temp2) then
125
xreal(j) = xreal(j+igap)
129
ximag(j) = ximag(j+igap)
146
else if (which .eq. 'SM') then
148
c %------------------------------------------------------%
149
c | Sort XREAL,XIMAG into decreasing order of magnitude. |
150
c %------------------------------------------------------%
153
if (igap .eq. 0) go to 9000
159
if (j .lt. 0) go to 60
161
temp1 = dlapy2(xreal(j),ximag(j))
162
temp2 = dlapy2(xreal(j+igap),ximag(j+igap))
164
if (temp1.lt.temp2) then
166
xreal(j) = xreal(j+igap)
170
ximag(j) = ximag(j+igap)
187
else if (which .eq. 'LR') then
189
c %------------------------------------------------%
190
c | Sort XREAL into increasing order of algebraic. |
191
c %------------------------------------------------%
194
if (igap .eq. 0) go to 9000
202
if (xreal(j).gt.xreal(j+igap)) then
204
xreal(j) = xreal(j+igap)
208
ximag(j) = ximag(j+igap)
225
else if (which .eq. 'SR') then
227
c %------------------------------------------------%
228
c | Sort XREAL into decreasing order of algebraic. |
229
c %------------------------------------------------%
232
if (igap .eq. 0) go to 9000
237
if (j.lt.0) go to 120
239
if (xreal(j).lt.xreal(j+igap)) then
241
xreal(j) = xreal(j+igap)
245
ximag(j) = ximag(j+igap)
262
else if (which .eq. 'LI') then
264
c %------------------------------------------------%
265
c | Sort XIMAG into increasing order of magnitude. |
266
c %------------------------------------------------%
269
if (igap .eq. 0) go to 9000
274
if (j.lt.0) go to 150
276
if (abs(ximag(j)).gt.abs(ximag(j+igap))) then
278
xreal(j) = xreal(j+igap)
282
ximag(j) = ximag(j+igap)
299
else if (which .eq. 'SI') then
301
c %------------------------------------------------%
302
c | Sort XIMAG into decreasing order of magnitude. |
303
c %------------------------------------------------%
306
if (igap .eq. 0) go to 9000
311
if (j.lt.0) go to 180
313
if (abs(ximag(j)).lt.abs(ximag(j+igap))) then
315
xreal(j) = xreal(j+igap)
319
ximag(j) = ximag(j+igap)