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*> \date November 2011 73* 74*> \ingroup double_eig 75* 76* ===================================================================== 77 SUBROUTINE DGET33( 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 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* 226 END 227