1*> \brief \b DGET33
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE DGET33( RMAX, LMAX, NINFO, KNT )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            KNT, LMAX, NINFO
15*       DOUBLE PRECISION   RMAX
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> DGET33 tests DLANV2, a routine for putting 2 by 2 blocks into
25*> standard form.  In other words, it computes a two by two rotation
26*> [[C,S];[-S,C]] where in
27*>
28*>    [ C S ][T(1,1) T(1,2)][ C -S ] = [ T11 T12 ]
29*>    [-S C ][T(2,1) T(2,2)][ S  C ]   [ T21 T22 ]
30*>
31*> either
32*>    1) T21=0 (real eigenvalues), or
33*>    2) T11=T22 and T21*T12<0 (complex conjugate eigenvalues).
34*> We also  verify that the residual is small.
35*> \endverbatim
36*
37*  Arguments:
38*  ==========
39*
40*> \param[out] RMAX
41*> \verbatim
42*>          RMAX is DOUBLE PRECISION
43*>          Value of the largest test ratio.
44*> \endverbatim
45*>
46*> \param[out] LMAX
47*> \verbatim
48*>          LMAX is INTEGER
49*>          Example number where largest test ratio achieved.
50*> \endverbatim
51*>
52*> \param[out] NINFO
53*> \verbatim
54*>          NINFO is INTEGER
55*>          Number of examples returned with INFO .NE. 0.
56*> \endverbatim
57*>
58*> \param[out] KNT
59*> \verbatim
60*>          KNT is INTEGER
61*>          Total number of examples tested.
62*> \endverbatim
63*
64*  Authors:
65*  ========
66*
67*> \author Univ. of Tennessee
68*> \author Univ. of California Berkeley
69*> \author Univ. of Colorado Denver
70*> \author NAG Ltd.
71*
72*> \ingroup double_eig
73*
74*  =====================================================================
75      SUBROUTINE DGET33( RMAX, LMAX, NINFO, KNT )
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*
223      END
224