LAPACK 3.12.1
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:125
Here is the call graph for this function:
Here is the caller graph for this function: