LAPACK  3.8.0
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.
Date
December 2016

Definition at line 78 of file dget33.f.

78 *
79 * -- LAPACK test routine (version 3.7.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 * December 2016
83 *
84 * .. Scalar Arguments ..
85  INTEGER knt, lmax, ninfo
86  DOUBLE PRECISION rmax
87 * ..
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92  DOUBLE PRECISION zero, one
93  parameter( zero = 0.0d0, one = 1.0d0 )
94  DOUBLE PRECISION two, four
95  parameter( two = 2.0d0, four = 4.0d0 )
96 * ..
97 * .. Local Scalars ..
98  INTEGER i1, i2, i3, i4, im1, im2, im3, im4, j1, j2, j3
99  DOUBLE PRECISION bignum, cs, eps, res, smlnum, sn, sum, tnrm,
100  $ wi1, wi2, wr1, wr2
101 * ..
102 * .. Local Arrays ..
103  DOUBLE PRECISION q( 2, 2 ), t( 2, 2 ), t1( 2, 2 ), t2( 2, 2 ),
104  $ val( 4 ), vm( 3 )
105 * ..
106 * .. External Functions ..
107  DOUBLE PRECISION dlamch
108  EXTERNAL dlamch
109 * ..
110 * .. External Subroutines ..
111  EXTERNAL dlabad, dlanv2
112 * ..
113 * .. Intrinsic Functions ..
114  INTRINSIC abs, max, sign
115 * ..
116 * .. Executable Statements ..
117 *
118 * Get machine parameters
119 *
120  eps = dlamch( 'P' )
121  smlnum = dlamch( 'S' ) / eps
122  bignum = one / smlnum
123  CALL dlabad( 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 dlanv2( 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 DGET33
225 *
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:129
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
Here is the call graph for this function:
Here is the caller graph for this function: