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

◆ zlanv2()

subroutine zlanv2 ( complex*16  a,
complex*16  b,
complex*16  c,
complex*16  d,
complex*16  rt1,
complex*16  rt2,
double precision  cs,
complex*16  sn 
)

Definition at line 1 of file zlanv2.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 DOUBLE PRECISION CS
10 COMPLEX*16 A, B, C, D, RT1, RT2, SN
11* ..
12*
13* Purpose
14* =======
15*
16* ZLANV2 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*16
26* B (input/output) COMPLEX*16
27* C (input/output) COMPLEX*16
28* D (input/output) COMPLEX*16
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*16
34* RT2 (output) COMPLEX*16
35* The two eigenvalues.
36*
37* CS (output) DOUBLE PRECISION
38* SN (output) COMPLEX*16
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 DOUBLE PRECISION RZERO, HALF, RONE
50 parameter( rzero = 0.0d+0, half = 0.5d+0,
51 $ rone = 1.0d+0 )
52 COMPLEX*16 ZERO, ONE
53 parameter( zero = ( 0.0d+0, 0.0d+0 ),
54 $ one = ( 1.0d+0, 0.0d+0 ) )
55* ..
56* .. Local Scalars ..
57 COMPLEX*16 AA, BB, DD, T, TEMP, TEMP2, U, X, Y
58 DOUBLE PRECISION ZR, ZI
59* ..
60* .. External Subroutines ..
61 EXTERNAL zlartg, dladiv
62* ..
63* .. Intrinsic Functions ..
64 INTRINSIC dble, dcmplx, dconjg, dimag, 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 = dcmplx( rzero, rone )*cs
95 ELSE
96 temp = sqrt( b+c )
97 CALL dladiv( dble( sqrt( b ) ), dimag( sqrt( b ) ),
98 $ dble( temp ), dimag( temp ), zr, zi )
99 temp2 = dcmplx( zr, zi )
100 cs = dble( temp2 )
101 CALL dladiv( dble( sqrt( c ) ), dimag( sqrt( c ) ),
102 $ dble( temp ), dimag( temp ), zr, zi )
103 sn = dcmplx( zr, zi )
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( dble( x )*dble( y )+dimag( x )*dimag( y ).LT.rzero )
117 $ y = -y
118 CALL dladiv( dble( u ), dimag( u ),
119 $ dble( x+y ), dimag( x+y ), zr, zi )
120 t = t - dcmplx( zr, zi )
121*
122* Do one QR step with exact shift T - resulting 2 x 2 in
123* triangular form.
124*
125 CALL zlartg( a-t, c, cs, sn, aa )
126*
127 d = d - t
128 bb = cs*b + sn*d
129 dd = -dconjg( sn )*b + cs*d
130*
131 a = aa*cs + bb*dconjg( 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 ZLANV2
147*
Here is the caller graph for this function: