LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

## ◆ sget33()

 subroutine sget33 ( real RMAX, integer LMAX, integer NINFO, integer KNT )

SGET33

Purpose:
``` SGET33 tests SLANV2, 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 REAL 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.```

Definition at line 75 of file sget33.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  REAL RMAX
84 * ..
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89  REAL ZERO, ONE
90  parameter( zero = 0.0e0, one = 1.0e0 )
91  REAL TWO, FOUR
92  parameter( two = 2.0e0, four = 4.0e0 )
93 * ..
94 * .. Local Scalars ..
95  INTEGER I1, I2, I3, I4, IM1, IM2, IM3, IM4, J1, J2, J3
96  REAL BIGNUM, CS, EPS, RES, SMLNUM, SN, SUM, TNRM,
97  \$ WI1, WI2, WR1, WR2
98 * ..
99 * .. Local Arrays ..
100  REAL Q( 2, 2 ), T( 2, 2 ), T1( 2, 2 ), T2( 2, 2 ),
101  \$ VAL( 4 ), VM( 3 )
102 * ..
103 * .. External Functions ..
104  REAL SLAMCH
105  EXTERNAL slamch
106 * ..
107 * .. External Subroutines ..
109 * ..
110 * .. Intrinsic Functions ..
111  INTRINSIC abs, max, sign
112 * ..
113 * .. Executable Statements ..
114 *
115 * Get machine parameters
116 *
117  eps = slamch( 'P' )
118  smlnum = slamch( 'S' ) / eps
119  bignum = one / smlnum
120  CALL slabad( 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 slanv2( 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 SGET33
222 *