LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ 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 dlabad, 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  CALL dlabad( smlnum, bignum )
121 *
122 * Set up test case parameters
123 *
124  val( 1 ) = one
125  val( 2 ) = one + two*eps
126  val( 3 ) = two
127  val( 4 ) = two - four*eps
128  vm( 1 ) = smlnum
129  vm( 2 ) = one
130  vm( 3 ) = bignum
131 *
132  knt = 0
133  ninfo = 0
134  lmax = 0
135  rmax = zero
136 *
137 * Begin test loop
138 *
139  DO 150 i1 = 1, 4
140  DO 140 i2 = 1, 4
141  DO 130 i3 = 1, 4
142  DO 120 i4 = 1, 4
143  DO 110 im1 = 1, 3
144  DO 100 im2 = 1, 3
145  DO 90 im3 = 1, 3
146  DO 80 im4 = 1, 3
147  t( 1, 1 ) = val( i1 )*vm( im1 )
148  t( 1, 2 ) = val( i2 )*vm( im2 )
149  t( 2, 1 ) = -val( i3 )*vm( im3 )
150  t( 2, 2 ) = val( i4 )*vm( im4 )
151  tnrm = max( abs( t( 1, 1 ) ),
152  $ abs( t( 1, 2 ) ), abs( t( 2, 1 ) ),
153  $ abs( t( 2, 2 ) ) )
154  t1( 1, 1 ) = t( 1, 1 )
155  t1( 1, 2 ) = t( 1, 2 )
156  t1( 2, 1 ) = t( 2, 1 )
157  t1( 2, 2 ) = t( 2, 2 )
158  q( 1, 1 ) = one
159  q( 1, 2 ) = zero
160  q( 2, 1 ) = zero
161  q( 2, 2 ) = one
162 *
163  CALL dlanv2( t( 1, 1 ), t( 1, 2 ),
164  $ t( 2, 1 ), t( 2, 2 ), wr1,
165  $ wi1, wr2, wi2, cs, sn )
166  DO 10 j1 = 1, 2
167  res = q( j1, 1 )*cs + q( j1, 2 )*sn
168  q( j1, 2 ) = -q( j1, 1 )*sn +
169  $ q( j1, 2 )*cs
170  q( j1, 1 ) = res
171  10 CONTINUE
172 *
173  res = zero
174  res = res + abs( q( 1, 1 )**2+
175  $ q( 1, 2 )**2-one ) / eps
176  res = res + abs( q( 2, 2 )**2+
177  $ q( 2, 1 )**2-one ) / eps
178  res = res + abs( q( 1, 1 )*q( 2, 1 )+
179  $ q( 1, 2 )*q( 2, 2 ) ) / eps
180  DO 40 j1 = 1, 2
181  DO 30 j2 = 1, 2
182  t2( j1, j2 ) = zero
183  DO 20 j3 = 1, 2
184  t2( j1, j2 ) = t2( j1, j2 ) +
185  $ t1( j1, j3 )*
186  $ q( j3, j2 )
187  20 CONTINUE
188  30 CONTINUE
189  40 CONTINUE
190  DO 70 j1 = 1, 2
191  DO 60 j2 = 1, 2
192  sum = t( j1, j2 )
193  DO 50 j3 = 1, 2
194  sum = sum - q( j3, j1 )*
195  $ t2( j3, j2 )
196  50 CONTINUE
197  res = res + abs( sum ) / eps / tnrm
198  60 CONTINUE
199  70 CONTINUE
200  IF( t( 2, 1 ).NE.zero .AND.
201  $ ( t( 1, 1 ).NE.t( 2,
202  $ 2 ) .OR. sign( one, t( 1,
203  $ 2 ) )*sign( one, t( 2,
204  $ 1 ) ).GT.zero ) )res = res + one / eps
205  knt = knt + 1
206  IF( res.GT.rmax ) THEN
207  lmax = knt
208  rmax = res
209  END IF
210  80 CONTINUE
211  90 CONTINUE
212  100 CONTINUE
213  110 CONTINUE
214  120 CONTINUE
215  130 CONTINUE
216  140 CONTINUE
217  150 CONTINUE
218 *
219  RETURN
220 *
221 * End of DGET33
222 *
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:74
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: