ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
clanv2.f
Go to the documentation of this file.
1  SUBROUTINE clanv2( A, B, C, D, RT1, RT2, CS, SN )
2 *
3 * -- ScaLAPACK routine (version 1.7) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * Courant Institute, Argonne National Lab, and Rice University
6 * May 28, 1999
7 *
8 * .. Scalar Arguments ..
9  REAL CS
10  COMPLEX A, B, C, D, RT1, RT2, SN
11 * ..
12 *
13 * Purpose
14 * =======
15 *
16 * CLANV2 computes the Schur factorization of a complex 2-by-2
17 * nonhermitian matrix in standard form:
18 *
19 * [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
20 * [ C D ] [ SN CS ] [ 0 DD ] [-SN CS ]
21 *
22 * Arguments
23 * =========
24 *
25 * A (input/output) COMPLEX
26 * B (input/output) COMPLEX
27 * C (input/output) COMPLEX
28 * D (input/output) COMPLEX
29 * On entry, the elements of the input matrix.
30 * On exit, they are overwritten by the elements of the
31 * standardised Schur form.
32 *
33 * RT1 (output) COMPLEX
34 * RT2 (output) COMPLEX
35 * The two eigenvalues.
36 *
37 * CS (output) REAL
38 * SN (output) COMPLEX
39 * Parameters of the rotation matrix.
40 *
41 * Further Details
42 * ===============
43 *
44 * Implemented by Mark R. Fahey, May 28, 1999
45 *
46 * =====================================================================
47 *
48 * .. Parameters ..
49  REAL RZERO, HALF, RONE
50  parameter( rzero = 0.0e+0, half = 0.5e+0,
51  $ rone = 1.0e+0 )
52  COMPLEX ZERO, ONE
53  parameter( zero = ( 0.0e+0, 0.0e+0 ),
54  $ one = ( 1.0e+0, 0.0e+0 ) )
55 * ..
56 * .. Local Scalars ..
57  COMPLEX AA, BB, DD, T, TEMP, TEMP2, U, X, Y
58 * ..
59 * .. External Functions ..
60  COMPLEX CLADIV
61  EXTERNAL cladiv
62 * ..
63 * .. External Subroutines ..
64  EXTERNAL clartg
65 * ..
66 * .. Intrinsic Functions ..
67  INTRINSIC real, cmplx, conjg, aimag, sqrt
68 * ..
69 * .. Executable Statements ..
70 *
71 * Initialize CS and SN
72 *
73  cs = rone
74  sn = zero
75 *
76  IF( c.EQ.zero ) THEN
77  GO TO 10
78 *
79  ELSE IF( b.EQ.zero ) THEN
80 *
81 * Swap rows and columns
82 *
83  cs = rzero
84  sn = one
85  temp = d
86  d = a
87  a = temp
88  b = -c
89  c = zero
90  GO TO 10
91  ELSE IF( ( a-d ).EQ.zero ) THEN
92  temp = sqrt( b*c )
93  a = a + temp
94  d = d - temp
95  IF( ( b+c ).EQ.zero ) THEN
96  cs = sqrt( half )
97  sn = cmplx( rzero, rone )*cs
98  ELSE
99  temp = sqrt( b+c )
100  temp2 = cladiv( sqrt( b ), temp )
101  cs = real( temp2 )
102  sn = cladiv( sqrt( c ), temp )
103  END IF
104  b = b - c
105  c = zero
106  GO TO 10
107  ELSE
108 *
109 * Compute eigenvalue closest to D
110 *
111  t = d
112  u = b*c
113  x = half*( a-t )
114  y = sqrt( x*x+u )
115  IF( real( x )*real( y )+aimag( x )*aimag( y ).LT.rzero )
116  $ y = -y
117  t = t - cladiv( u, ( x+y ) )
118 *
119 * Do one QR step with exact shift T - resulting 2 x 2 in
120 * triangular form.
121 *
122  CALL clartg( a-t, c, cs, sn, aa )
123 *
124  d = d - t
125  bb = cs*b + sn*d
126  dd = -conjg( sn )*b + cs*d
127 *
128  a = aa*cs + bb*conjg( sn ) + t
129  b = -aa*sn + bb*cs
130  c = zero
131  d = t
132 *
133  END IF
134 *
135  10 CONTINUE
136 *
137 * Store eigenvalues in RT1 and RT2.
138 *
139  rt1 = a
140  rt2 = d
141  RETURN
142 *
143 * End of CLANV2
144 *
145  END
cmplx
float cmplx[2]
Definition: pblas.h:132
clanv2
subroutine clanv2(A, B, C, D, RT1, RT2, CS, SN)
Definition: clanv2.f:2