OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zlanv2.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine zlanv2 (a, b, c, d, rt1, rt2, cs, sn)

Function/Subroutine Documentation

◆ 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* ..
59* .. External Functions ..
60 COMPLEX*16 ZLADIV
61 EXTERNAL zladiv
62* ..
63* .. External Subroutines ..
64 EXTERNAL zlartg
65* ..
66* .. Intrinsic Functions ..
67 INTRINSIC dble, dcmplx, dconjg, dimag, 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 = dcmplx( rzero, rone )*cs
98 ELSE
99 temp = sqrt( b+c )
100 temp2 = zladiv( sqrt( b ), temp )
101 cs = dble( temp2 )
102 sn = zladiv( 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( dble( x )*dble( y )+dimag( x )*dimag( y ).LT.rzero )
116 $ y = -y
117 t = t - zladiv( u, ( x+y ) )
118*
119* Do one QR step with exact shift T - resulting 2 x 2 in
120* triangular form.
121*
122 CALL zlartg( a-t, c, cs, sn, aa )
123*
124 d = d - t
125 bb = cs*b + sn*d
126 dd = -dconjg( sn )*b + cs*d
127*
128 a = aa*cs + bb*dconjg( 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 ZLANV2
144*
zlartg
subroutine zlartg(f, g, c, s, r)
ZLARTG generates a plane rotation with real cosine and complex sine.
Definition zlartg.f90:118
zladiv
complex *16 function zladiv(x, y)
ZLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
Definition zladiv.f:64