1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
SUBROUTINE DLASORTE ( S, LDS, J, OUT, INFO )
*
* -- ScaLAPACK routine (version 1.5) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* .. Scalar Arguments ..
INTEGER INFO, J, LDS
* ..
* .. Array Arguments ..
DOUBLE PRECISION OUT( J, * ), S( LDS, * )
* ..
*
* Purpose
* =======
*
* DLASORTE sorts eigenpairs so that real eigenpairs are together and
* complex are together. This way one can employ 2x2 shifts easily
* since every 2nd subdiagonal is guaranteed to be zero.
* This routine does no parallel work and makes no calls.
*
* Arguments
* =========
*
* S (local input/output) DOUBLE PRECISION array, dimension LDS
* On entry, a matrix already in Schur form.
* On exit, the diagonal blocks of S have been rewritten to pair
* the eigenvalues. The resulting matrix is no longer
* similar to the input.
*
* LDS (local input) INTEGER
* On entry, the leading dimension of the local array S.
* Unchanged on exit.
*
* J (local input) INTEGER
* On entry, the order of the matrix S.
* Unchanged on exit.
*
* OUT (local input/output) DOUBLE PRECISION array, dimension Jx2
* This is the work buffer required by this routine.
*
* INFO (local input) INTEGER
* This is set if the input matrix had an odd number of real
* eigenvalues and things couldn't be paired or if the input
* matrix S was not originally in Schur form.
* 0 indicates successful completion.
*
* Implemented by: G. Henry, May 1, 1997
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
INTEGER I, LAST
INTEGER LASTC, LASTR
* ..
* .. Intrinsic Functions ..
INTRINSIC MOD
* ..
* .. Executable Statements ..
*
LASTC = J
LASTR = J
LAST = J
INFO = 0
DO 10 I = J - 1, 1, -1
IF ( S( I+1, I ) .EQ. ZERO ) THEN
IF ( LAST - I .EQ. 2 ) THEN
* We have a double!
OUT( LASTC-1, 1 ) = S( I+1, I+1 )
OUT( LASTC, 2 ) = S( I+2, I+2 )
OUT( LASTC-1, 2 ) = S( I+1, I+2 )
OUT( LASTC, 1 ) = S( I+2, I+1 )
LASTC = LASTC - 2
END IF
IF ( LAST - I .EQ. 1 ) THEN
* We have a single!
IF ( MOD(J - I, 2 ) .EQ. 1 ) THEN
* We have done an odd number, so this must be 1st
OUT( LASTC, 1 ) = ZERO
OUT( LASTC, 2 ) = S ( I+1,I+1 )
LASTR = LASTC - 1
LASTC = LASTC - 2
ELSE
* We have an even number, so this must be 2nd
OUT( LASTR, 1 ) = S ( I+1,I+1 )
OUT( LASTR, 2 ) = ZERO
END IF
END IF
IF ( LAST - I .GT. 2 ) THEN
INFO = I
END IF
LAST = I
END IF
10 CONTINUE
IF( LAST.EQ.2 ) THEN
*
* GRAB LAST DOUBLE PAIR
*
OUT( LASTC-1, 1 ) = S( 1, 1 )
OUT( LASTC, 2 ) = S( 2, 2 )
OUT( LASTC-1, 2 ) = S( 1, 2 )
OUT( LASTC, 1 ) = S( 2, 1 )
END IF
IF ( LAST .EQ. 1 ) THEN
*
* GRAB LAST ELEMENT OF LAST SINGLE PAIR
*
OUT( LASTR, 1 ) = S ( 1,1 )
OUT( LASTR, 2 ) = ZERO
END IF
*
* Overwrite the S diagonals
*
DO 20 I = 1, J, 2
S( I, I ) = OUT( I, 1 )
S( I+1, I ) = OUT( I+1, 1 )
S( I, I+1 ) = OUT( I, 2 )
S( I+1, I+1 ) = OUT( I+1, 2 )
20 CONTINUE
*
RETURN
*
* End of DLASORTE
*
END
|
