ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
slasorte.f
Go to the documentation of this file.
1  SUBROUTINE slasorte( S, LDS, J, OUT, INFO )
2 *
3 * -- ScaLAPACK routine (version 1.7) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * December 31, 1998
7 *
8 * .. Scalar Arguments ..
9  INTEGER INFO, J, LDS
10 * ..
11 * .. Array Arguments ..
12  REAL OUT( J, * ), S( LDS, * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SLASORTE sorts eigenpairs so that real eigenpairs are together and
19 * complex are together. This way one can employ 2x2 shifts easily
20 * since every 2nd subdiagonal is guaranteed to be zero.
21 * This routine does no parallel work.
22 *
23 * Arguments
24 * =========
25 *
26 * S (local input/output) REAL array, dimension LDS
27 * On entry, a matrix already in Schur form.
28 * On exit, the diagonal blocks of S have been rewritten to pair
29 * the eigenvalues. The resulting matrix is no longer
30 * similar to the input.
31 *
32 * LDS (local input) INTEGER
33 * On entry, the leading dimension of the local array S.
34 * Unchanged on exit.
35 *
36 * J (local input) INTEGER
37 * On entry, the order of the matrix S.
38 * Unchanged on exit.
39 *
40 * OUT (local input/output) REAL array, dimension Jx2
41 * This is the work buffer required by this routine.
42 *
43 * INFO (local input) INTEGER
44 * This is set if the input matrix had an odd number of real
45 * eigenvalues and things couldn't be paired or if the input
46 * matrix S was not originally in Schur form.
47 * 0 indicates successful completion.
48 *
49 * Implemented by: G. Henry, November 17, 1996
50 *
51 * =====================================================================
52 *
53 * .. Parameters ..
54  REAL ZERO
55  parameter( zero = 0.0e+0 )
56 * ..
57 * .. Local Scalars ..
58  INTEGER BOT, I, LAST, TOP
59 * ..
60 * .. Intrinsic Functions ..
61  INTRINSIC mod
62 * ..
63 * .. Executable Statements ..
64 *
65  last = j
66  top = 1
67  bot = j
68  info = 0
69  DO 10 i = j - 1, 1, -1
70  IF( s( i+1, i ).EQ.zero ) THEN
71  IF( last-i.EQ.2 ) THEN
72  out( bot-1, 1 ) = s( i+1, i+1 )
73  out( bot, 2 ) = s( i+2, i+2 )
74  out( bot-1, 2 ) = s( i+1, i+2 )
75  out( bot, 1 ) = s( i+2, i+1 )
76  bot = bot - 2
77  END IF
78  IF( last-i.EQ.1 ) THEN
79  IF( mod( top, 2 ).EQ.1 ) THEN
80 *
81 * FIRST OF A PAIR
82 *
83  IF( ( i.EQ.j-1 ) .OR. ( i.EQ.1 ) ) THEN
84  out( top, 1 ) = s( i+1, i+1 )
85  ELSE
86  out( top, 1 ) = s( i+1, i+1 )
87  END IF
88  out( top, 2 ) = zero
89  ELSE
90 *
91 * SECOND OF A PAIR
92 *
93  IF( ( i.EQ.j-1 ) .OR. ( i.EQ.1 ) ) THEN
94  out( top, 2 ) = s( i+1, i+1 )
95  ELSE
96  out( top, 2 ) = s( i+1, i+1 )
97  END IF
98  out( top, 1 ) = zero
99  END IF
100  top = top + 1
101  END IF
102  IF( last-i.GT.2 ) THEN
103  info = i
104  RETURN
105  END IF
106  last = i
107  END IF
108  10 CONTINUE
109  IF( last.EQ.2 ) THEN
110 *
111 * GRAB LAST DOUBLE PAIR
112 *
113  out( bot-1, 1 ) = s( 1, 1 )
114  out( bot, 2 ) = s( 2, 2 )
115  out( bot-1, 2 ) = s( 1, 2 )
116  out( bot, 1 ) = s( 2, 1 )
117  bot = bot - 2
118  END IF
119  IF( last.EQ.1 .and. mod(top, 2) .eq. 0 ) THEN
120 *
121 * GRAB SECOND PART OF LAST PAIR
122 *
123  out(top, 2) = s(1,1)
124  out(top, 1) = zero
125  top = top + 1
126  END IF
127  IF( top-1.NE.bot ) THEN
128  info = -bot
129  RETURN
130  END IF
131 *
132 * Overwrite the S diagonals
133 *
134  DO 20 i = 1, j, 2
135  s( i, i ) = out( i, 1 )
136  s( i+1, i ) = out( i+1, 1 )
137  s( i, i+1 ) = out( i, 2 )
138  s( i+1, i+1 ) = out( i+1, 2 )
139  20 CONTINUE
140 *
141  RETURN
142 *
143 * End of SLASORTE
144 *
145  END
slasorte
subroutine slasorte(S, LDS, J, OUT, INFO)
Definition: slasorte.f:2