LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dget33()

subroutine dget33 ( double precision  rmax,
integer  lmax,
integer  ninfo,
integer  knt 
)

DGET33

Purpose:
 DGET33 tests DLANV2, a routine for putting 2 by 2 blocks into
 standard form.  In other words, it computes a two by two rotation
 [[C,S];[-S,C]] where in

    [ C S ][T(1,1) T(1,2)][ C -S ] = [ T11 T12 ]
    [-S C ][T(2,1) T(2,2)][ S  C ]   [ T21 T22 ]

 either
    1) T21=0 (real eigenvalues), or
    2) T11=T22 and T21*T12<0 (complex conjugate eigenvalues).
 We also  verify that the residual is small.
Parameters
[out]RMAX
          RMAX is DOUBLE PRECISION
          Value of the largest test ratio.
[out]LMAX
          LMAX is INTEGER
          Example number where largest test ratio achieved.
[out]NINFO
          NINFO is INTEGER
          Number of examples returned with INFO .NE. 0.
[out]KNT
          KNT is INTEGER
          Total number of examples tested.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 75 of file dget33.f.

76*
77* -- LAPACK test routine --
78* -- LAPACK is a software package provided by Univ. of Tennessee, --
79* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
80*
81* .. Scalar Arguments ..
82 INTEGER KNT, LMAX, NINFO
83 DOUBLE PRECISION RMAX
84* ..
85*
86* =====================================================================
87*
88* .. Parameters ..
89 DOUBLE PRECISION ZERO, ONE
90 parameter( zero = 0.0d0, one = 1.0d0 )
91 DOUBLE PRECISION TWO, FOUR
92 parameter( two = 2.0d0, four = 4.0d0 )
93* ..
94* .. Local Scalars ..
95 INTEGER I1, I2, I3, I4, IM1, IM2, IM3, IM4, J1, J2, J3
96 DOUBLE PRECISION BIGNUM, CS, EPS, RES, SMLNUM, SN, SUM, TNRM,
97 $ WI1, WI2, WR1, WR2
98* ..
99* .. Local Arrays ..
100 DOUBLE PRECISION Q( 2, 2 ), T( 2, 2 ), T1( 2, 2 ), T2( 2, 2 ),
101 $ VAL( 4 ), VM( 3 )
102* ..
103* .. External Functions ..
104 DOUBLE PRECISION DLAMCH
105 EXTERNAL dlamch
106* ..
107* .. External Subroutines ..
108 EXTERNAL dlanv2
109* ..
110* .. Intrinsic Functions ..
111 INTRINSIC abs, max, sign
112* ..
113* .. Executable Statements ..
114*
115* Get machine parameters
116*
117 eps = dlamch( 'P' )
118 smlnum = dlamch( 'S' ) / eps
119 bignum = one / smlnum
120*
121* Set up test case parameters
122*
123 val( 1 ) = one
124 val( 2 ) = one + two*eps
125 val( 3 ) = two
126 val( 4 ) = two - four*eps
127 vm( 1 ) = smlnum
128 vm( 2 ) = one
129 vm( 3 ) = bignum
130*
131 knt = 0
132 ninfo = 0
133 lmax = 0
134 rmax = zero
135*
136* Begin test loop
137*
138 DO 150 i1 = 1, 4
139 DO 140 i2 = 1, 4
140 DO 130 i3 = 1, 4
141 DO 120 i4 = 1, 4
142 DO 110 im1 = 1, 3
143 DO 100 im2 = 1, 3
144 DO 90 im3 = 1, 3
145 DO 80 im4 = 1, 3
146 t( 1, 1 ) = val( i1 )*vm( im1 )
147 t( 1, 2 ) = val( i2 )*vm( im2 )
148 t( 2, 1 ) = -val( i3 )*vm( im3 )
149 t( 2, 2 ) = val( i4 )*vm( im4 )
150 tnrm = max( abs( t( 1, 1 ) ),
151 $ abs( t( 1, 2 ) ), abs( t( 2, 1 ) ),
152 $ abs( t( 2, 2 ) ) )
153 t1( 1, 1 ) = t( 1, 1 )
154 t1( 1, 2 ) = t( 1, 2 )
155 t1( 2, 1 ) = t( 2, 1 )
156 t1( 2, 2 ) = t( 2, 2 )
157 q( 1, 1 ) = one
158 q( 1, 2 ) = zero
159 q( 2, 1 ) = zero
160 q( 2, 2 ) = one
161*
162 CALL dlanv2( t( 1, 1 ), t( 1, 2 ),
163 $ t( 2, 1 ), t( 2, 2 ), wr1,
164 $ wi1, wr2, wi2, cs, sn )
165 DO 10 j1 = 1, 2
166 res = q( j1, 1 )*cs + q( j1, 2 )*sn
167 q( j1, 2 ) = -q( j1, 1 )*sn +
168 $ q( j1, 2 )*cs
169 q( j1, 1 ) = res
170 10 CONTINUE
171*
172 res = zero
173 res = res + abs( q( 1, 1 )**2+
174 $ q( 1, 2 )**2-one ) / eps
175 res = res + abs( q( 2, 2 )**2+
176 $ q( 2, 1 )**2-one ) / eps
177 res = res + abs( q( 1, 1 )*q( 2, 1 )+
178 $ q( 1, 2 )*q( 2, 2 ) ) / eps
179 DO 40 j1 = 1, 2
180 DO 30 j2 = 1, 2
181 t2( j1, j2 ) = zero
182 DO 20 j3 = 1, 2
183 t2( j1, j2 ) = t2( j1, j2 ) +
184 $ t1( j1, j3 )*
185 $ q( j3, j2 )
186 20 CONTINUE
187 30 CONTINUE
188 40 CONTINUE
189 DO 70 j1 = 1, 2
190 DO 60 j2 = 1, 2
191 sum = t( j1, j2 )
192 DO 50 j3 = 1, 2
193 sum = sum - q( j3, j1 )*
194 $ t2( j3, j2 )
195 50 CONTINUE
196 res = res + abs( sum ) / eps / tnrm
197 60 CONTINUE
198 70 CONTINUE
199 IF( t( 2, 1 ).NE.zero .AND.
200 $ ( t( 1, 1 ).NE.t( 2,
201 $ 2 ) .OR. sign( one, t( 1,
202 $ 2 ) )*sign( one, t( 2,
203 $ 1 ) ).GT.zero ) )res = res + one / eps
204 knt = knt + 1
205 IF( res.GT.rmax ) THEN
206 lmax = knt
207 rmax = res
208 END IF
209 80 CONTINUE
210 90 CONTINUE
211 100 CONTINUE
212 110 CONTINUE
213 120 CONTINUE
214 130 CONTINUE
215 140 CONTINUE
216 150 CONTINUE
217*
218 RETURN
219*
220* End of DGET33
221*
dlamch
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
dlanv2
subroutine dlanv2(a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn)
DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form.
Definition dlanv2.f:127
Here is the call graph for this function:
Here is the caller graph for this function: