1*> \brief \b SGET33
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 SGET33( RMAX, LMAX, NINFO, KNT )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            KNT, LMAX, NINFO
15*       REAL               RMAX
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> SGET33 tests SLANV2, 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 REAL
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*> \date November 2011
73*
74*> \ingroup single_eig
75*
76*  =====================================================================
77      SUBROUTINE SGET33( RMAX, LMAX, NINFO, KNT )
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 ..
111      EXTERNAL           SLABAD, SLANV2
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*
226      END
227