LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 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.```
Date
November 2011

Definition at line 78 of file sget33.f.

78 *
79 * -- LAPACK test routine (version 3.4.0) --
80 * -- LAPACK is a software package provided by Univ. of Tennessee, --
81 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
82 * November 2011
83 *
84 * .. Scalar Arguments ..
85  INTEGER knt, lmax, ninfo
86  REAL rmax
87 * ..
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92  REAL zero, one
93  parameter ( zero = 0.0e0, one = 1.0e0 )
94  REAL two, four
95  parameter ( two = 2.0e0, four = 4.0e0 )
96 * ..
97 * .. Local Scalars ..
98  INTEGER i1, i2, i3, i4, im1, im2, im3, im4, j1, j2, j3
99  REAL bignum, cs, eps, res, smlnum, sn, sum, tnrm,
100  \$ wi1, wi2, wr1, wr2
101 * ..
102 * .. Local Arrays ..
103  REAL q( 2, 2 ), t( 2, 2 ), t1( 2, 2 ), t2( 2, 2 ),
104  \$ val( 4 ), vm( 3 )
105 * ..
106 * .. External Functions ..
107  REAL slamch
108  EXTERNAL slamch
109 * ..
110 * .. External Subroutines ..
112 * ..
113 * .. Intrinsic Functions ..
114  INTRINSIC abs, max, sign
115 * ..
116 * .. Executable Statements ..
117 *
118 * Get machine parameters
119 *
120  eps = slamch( 'P' )
121  smlnum = slamch( 'S' ) / eps
122  bignum = one / smlnum
123  CALL slabad( smlnum, bignum )
124 *
125 * Set up test case parameters
126 *
127  val( 1 ) = one
128  val( 2 ) = one + two*eps
129  val( 3 ) = two
130  val( 4 ) = two - four*eps
131  vm( 1 ) = smlnum
132  vm( 2 ) = one
133  vm( 3 ) = bignum
134 *
135  knt = 0
136  ninfo = 0
137  lmax = 0
138  rmax = zero
139 *
140 * Begin test loop
141 *
142  DO 150 i1 = 1, 4
143  DO 140 i2 = 1, 4
144  DO 130 i3 = 1, 4
145  DO 120 i4 = 1, 4
146  DO 110 im1 = 1, 3
147  DO 100 im2 = 1, 3
148  DO 90 im3 = 1, 3
149  DO 80 im4 = 1, 3
150  t( 1, 1 ) = val( i1 )*vm( im1 )
151  t( 1, 2 ) = val( i2 )*vm( im2 )
152  t( 2, 1 ) = -val( i3 )*vm( im3 )
153  t( 2, 2 ) = val( i4 )*vm( im4 )
154  tnrm = max( abs( t( 1, 1 ) ),
155  \$ abs( t( 1, 2 ) ), abs( t( 2, 1 ) ),
156  \$ abs( t( 2, 2 ) ) )
157  t1( 1, 1 ) = t( 1, 1 )
158  t1( 1, 2 ) = t( 1, 2 )
159  t1( 2, 1 ) = t( 2, 1 )
160  t1( 2, 2 ) = t( 2, 2 )
161  q( 1, 1 ) = one
162  q( 1, 2 ) = zero
163  q( 2, 1 ) = zero
164  q( 2, 2 ) = one
165 *
166  CALL slanv2( t( 1, 1 ), t( 1, 2 ),
167  \$ t( 2, 1 ), t( 2, 2 ), wr1,
168  \$ wi1, wr2, wi2, cs, sn )
169  DO 10 j1 = 1, 2
170  res = q( j1, 1 )*cs + q( j1, 2 )*sn
171  q( j1, 2 ) = -q( j1, 1 )*sn +
172  \$ q( j1, 2 )*cs
173  q( j1, 1 ) = res
174  10 CONTINUE
175 *
176  res = zero
177  res = res + abs( q( 1, 1 )**2+
178  \$ q( 1, 2 )**2-one ) / eps
179  res = res + abs( q( 2, 2 )**2+
180  \$ q( 2, 1 )**2-one ) / eps
181  res = res + abs( q( 1, 1 )*q( 2, 1 )+
182  \$ q( 1, 2 )*q( 2, 2 ) ) / eps
183  DO 40 j1 = 1, 2
184  DO 30 j2 = 1, 2
185  t2( j1, j2 ) = zero
186  DO 20 j3 = 1, 2
187  t2( j1, j2 ) = t2( j1, j2 ) +
188  \$ t1( j1, j3 )*
189  \$ q( j3, j2 )
190  20 CONTINUE
191  30 CONTINUE
192  40 CONTINUE
193  DO 70 j1 = 1, 2
194  DO 60 j2 = 1, 2
195  sum = t( j1, j2 )
196  DO 50 j3 = 1, 2
197  sum = sum - q( j3, j1 )*
198  \$ t2( j3, j2 )
199  50 CONTINUE
200  res = res + abs( sum ) / eps / tnrm
201  60 CONTINUE
202  70 CONTINUE
203  IF( t( 2, 1 ).NE.zero .AND.
204  \$ ( t( 1, 1 ).NE.t( 2,
205  \$ 2 ) .OR. sign( one, t( 1,
206  \$ 2 ) )*sign( one, t( 2,
207  \$ 1 ) ).GT.zero ) )res = res + one / eps
208  knt = knt + 1
209  IF( res.GT.rmax ) THEN
210  lmax = knt
211  rmax = res
212  END IF
213  80 CONTINUE
214  90 CONTINUE
215  100 CONTINUE
216  110 CONTINUE
217  120 CONTINUE
218  130 CONTINUE
219  140 CONTINUE
220  150 CONTINUE
221 *
222  RETURN
223 *
224 * End of SGET33
225 *
subroutine slanv2(A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN)
SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form...
Definition: slanv2.f:129
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: