SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ clanv2()

subroutine clanv2 ( complex  a,
complex  b,
complex  c,
complex  d,
complex  rt1,
complex  rt2,
real  cs,
complex  sn 
)

Definition at line 1 of file clanv2.f.

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 REAL CR, CI
59* ..
60* .. External Subroutines ..
61 EXTERNAL clartg, sladiv
62* ..
63* .. Intrinsic Functions ..
64 INTRINSIC real, cmplx, conjg, aimag, sqrt
65* ..
66* .. Executable Statements ..
67*
68* Initialize CS and SN
69*
70 cs = rone
71 sn = zero
72*
73 IF( c.EQ.zero ) THEN
74 GO TO 10
75*
76 ELSE IF( b.EQ.zero ) THEN
77*
78* Swap rows and columns
79*
80 cs = rzero
81 sn = one
82 temp = d
83 d = a
84 a = temp
85 b = -c
86 c = zero
87 GO TO 10
88 ELSE IF( ( a-d ).EQ.zero ) THEN
89 temp = sqrt( b*c )
90 a = a + temp
91 d = d - temp
92 IF( ( b+c ).EQ.zero ) THEN
93 cs = sqrt( half )
94 sn = cmplx( rzero, rone )*cs
95 ELSE
96 temp = sqrt( b+c )
97 CALL sladiv( real( sqrt( b ) ), aimag( sqrt( b ) ),
98 $ real( temp ), aimag( temp ), cr, ci )
99 temp2 = cmplx( cr, ci )
100 cs = real( temp2 )
101 CALL sladiv( real( sqrt( c ) ), aimag( sqrt( c ) ),
102 $ real( temp ), aimag( temp ), cr, ci )
103 sn = cmplx( cr, ci )
104 END IF
105 b = b - c
106 c = zero
107 GO TO 10
108 ELSE
109*
110* Compute eigenvalue closest to D
111*
112 t = d
113 u = b*c
114 x = half*( a-t )
115 y = sqrt( x*x+u )
116 IF( real( x )*real( y )+aimag( x )*aimag( y ).LT.rzero )
117 $ y = -y
118 CALL sladiv( real( u ), aimag( u ),
119 $ real( x+y ), aimag( x+y ), cr, ci )
120 t = t - cmplx( cr, ci )
121*
122* Do one QR step with exact shift T - resulting 2 x 2 in
123* triangular form.
124*
125 CALL clartg( a-t, c, cs, sn, aa )
126*
127 d = d - t
128 bb = cs*b + sn*d
129 dd = -conjg( sn )*b + cs*d
130*
131 a = aa*cs + bb*conjg( sn ) + t
132 b = -aa*sn + bb*cs
133 c = zero
134 d = t
135*
136 END IF
137*
138 10 CONTINUE
139*
140* Store eigenvalues in RT1 and RT2.
141*
142 rt1 = a
143 rt2 = d
144 RETURN
145*
146* End of CLANV2
147*
float cmplx[2]
Definition pblas.h:136
Here is the caller graph for this function: