1 SUBROUTINE DGET33( RMAX, LMAX, NINFO, KNT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER KNT, LMAX, NINFO
9 DOUBLE PRECISION RMAX
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DGET33 tests DLANV2, a routine for putting 2 by 2 blocks into
16 * standard form. In other words, it computes a two by two rotation
17 * [[C,S];[-S,C]] where in
18 *
19 * [ C S ][T(1,1) T(1,2)][ C -S ] = [ T11 T12 ]
20 * [-S C ][T(2,1) T(2,2)][ S C ] [ T21 T22 ]
21 *
22 * either
23 * 1) T21=0 (real eigenvalues), or
24 * 2) T11=T22 and T21*T12<0 (complex conjugate eigenvalues).
25 * We also verify that the residual is small.
26 *
27 * Arguments
28 * ==========
29 *
30 * RMAX (output) DOUBLE PRECISION
31 * Value of the largest test ratio.
32 *
33 * LMAX (output) INTEGER
34 * Example number where largest test ratio achieved.
35 *
36 * NINFO (output) INTEGER
37 * Number of examples returned with INFO .NE. 0.
38 *
39 * KNT (output) INTEGER
40 * Total number of examples tested.
41 *
42 * =====================================================================
43 *
44 * .. Parameters ..
45 DOUBLE PRECISION ZERO, ONE
46 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
47 DOUBLE PRECISION TWO, FOUR
48 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0 )
49 * ..
50 * .. Local Scalars ..
51 INTEGER I1, I2, I3, I4, IM1, IM2, IM3, IM4, J1, J2, J3
52 DOUBLE PRECISION BIGNUM, CS, EPS, RES, SMLNUM, SN, SUM, TNRM,
53 $ WI1, WI2, WR1, WR2
54 * ..
55 * .. Local Arrays ..
56 DOUBLE PRECISION Q( 2, 2 ), T( 2, 2 ), T1( 2, 2 ), T2( 2, 2 ),
57 $ VAL( 4 ), VM( 3 )
58 * ..
59 * .. External Functions ..
60 DOUBLE PRECISION DLAMCH
61 EXTERNAL DLAMCH
62 * ..
63 * .. External Subroutines ..
64 EXTERNAL DLABAD, DLANV2
65 * ..
66 * .. Intrinsic Functions ..
67 INTRINSIC ABS, MAX, SIGN
68 * ..
69 * .. Executable Statements ..
70 *
71 * Get machine parameters
72 *
73 EPS = DLAMCH( 'P' )
74 SMLNUM = DLAMCH( 'S' ) / EPS
75 BIGNUM = ONE / SMLNUM
76 CALL DLABAD( SMLNUM, BIGNUM )
77 *
78 * Set up test case parameters
79 *
80 VAL( 1 ) = ONE
81 VAL( 2 ) = ONE + TWO*EPS
82 VAL( 3 ) = TWO
83 VAL( 4 ) = TWO - FOUR*EPS
84 VM( 1 ) = SMLNUM
85 VM( 2 ) = ONE
86 VM( 3 ) = BIGNUM
87 *
88 KNT = 0
89 NINFO = 0
90 LMAX = 0
91 RMAX = ZERO
92 *
93 * Begin test loop
94 *
95 DO 150 I1 = 1, 4
96 DO 140 I2 = 1, 4
97 DO 130 I3 = 1, 4
98 DO 120 I4 = 1, 4
99 DO 110 IM1 = 1, 3
100 DO 100 IM2 = 1, 3
101 DO 90 IM3 = 1, 3
102 DO 80 IM4 = 1, 3
103 T( 1, 1 ) = VAL( I1 )*VM( IM1 )
104 T( 1, 2 ) = VAL( I2 )*VM( IM2 )
105 T( 2, 1 ) = -VAL( I3 )*VM( IM3 )
106 T( 2, 2 ) = VAL( I4 )*VM( IM4 )
107 TNRM = MAX( ABS( T( 1, 1 ) ),
108 $ ABS( T( 1, 2 ) ), ABS( T( 2, 1 ) ),
109 $ ABS( T( 2, 2 ) ) )
110 T1( 1, 1 ) = T( 1, 1 )
111 T1( 1, 2 ) = T( 1, 2 )
112 T1( 2, 1 ) = T( 2, 1 )
113 T1( 2, 2 ) = T( 2, 2 )
114 Q( 1, 1 ) = ONE
115 Q( 1, 2 ) = ZERO
116 Q( 2, 1 ) = ZERO
117 Q( 2, 2 ) = ONE
118 *
119 CALL DLANV2( T( 1, 1 ), T( 1, 2 ),
120 $ T( 2, 1 ), T( 2, 2 ), WR1,
121 $ WI1, WR2, WI2, CS, SN )
122 DO 10 J1 = 1, 2
123 RES = Q( J1, 1 )*CS + Q( J1, 2 )*SN
124 Q( J1, 2 ) = -Q( J1, 1 )*SN +
125 $ Q( J1, 2 )*CS
126 Q( J1, 1 ) = RES
127 10 CONTINUE
128 *
129 RES = ZERO
130 RES = RES + ABS( Q( 1, 1 )**2+
131 $ Q( 1, 2 )**2-ONE ) / EPS
132 RES = RES + ABS( Q( 2, 2 )**2+
133 $ Q( 2, 1 )**2-ONE ) / EPS
134 RES = RES + ABS( Q( 1, 1 )*Q( 2, 1 )+
135 $ Q( 1, 2 )*Q( 2, 2 ) ) / EPS
136 DO 40 J1 = 1, 2
137 DO 30 J2 = 1, 2
138 T2( J1, J2 ) = ZERO
139 DO 20 J3 = 1, 2
140 T2( J1, J2 ) = T2( J1, J2 ) +
141 $ T1( J1, J3 )*
142 $ Q( J3, J2 )
143 20 CONTINUE
144 30 CONTINUE
145 40 CONTINUE
146 DO 70 J1 = 1, 2
147 DO 60 J2 = 1, 2
148 SUM = T( J1, J2 )
149 DO 50 J3 = 1, 2
150 SUM = SUM - Q( J3, J1 )*
151 $ T2( J3, J2 )
152 50 CONTINUE
153 RES = RES + ABS( SUM ) / EPS / TNRM
154 60 CONTINUE
155 70 CONTINUE
156 IF( T( 2, 1 ).NE.ZERO .AND.
157 $ ( T( 1, 1 ).NE.T( 2,
158 $ 2 ) .OR. SIGN( ONE, T( 1,
159 $ 2 ) )*SIGN( ONE, T( 2,
160 $ 1 ) ).GT.ZERO ) )RES = RES + ONE / EPS
161 KNT = KNT + 1
162 IF( RES.GT.RMAX ) THEN
163 LMAX = KNT
164 RMAX = RES
165 END IF
166 80 CONTINUE
167 90 CONTINUE
168 100 CONTINUE
169 110 CONTINUE
170 120 CONTINUE
171 130 CONTINUE
172 140 CONTINUE
173 150 CONTINUE
174 *
175 RETURN
176 *
177 * End of DGET33
178 *
179 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER KNT, LMAX, NINFO
9 DOUBLE PRECISION RMAX
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DGET33 tests DLANV2, a routine for putting 2 by 2 blocks into
16 * standard form. In other words, it computes a two by two rotation
17 * [[C,S];[-S,C]] where in
18 *
19 * [ C S ][T(1,1) T(1,2)][ C -S ] = [ T11 T12 ]
20 * [-S C ][T(2,1) T(2,2)][ S C ] [ T21 T22 ]
21 *
22 * either
23 * 1) T21=0 (real eigenvalues), or
24 * 2) T11=T22 and T21*T12<0 (complex conjugate eigenvalues).
25 * We also verify that the residual is small.
26 *
27 * Arguments
28 * ==========
29 *
30 * RMAX (output) DOUBLE PRECISION
31 * Value of the largest test ratio.
32 *
33 * LMAX (output) INTEGER
34 * Example number where largest test ratio achieved.
35 *
36 * NINFO (output) INTEGER
37 * Number of examples returned with INFO .NE. 0.
38 *
39 * KNT (output) INTEGER
40 * Total number of examples tested.
41 *
42 * =====================================================================
43 *
44 * .. Parameters ..
45 DOUBLE PRECISION ZERO, ONE
46 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
47 DOUBLE PRECISION TWO, FOUR
48 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0 )
49 * ..
50 * .. Local Scalars ..
51 INTEGER I1, I2, I3, I4, IM1, IM2, IM3, IM4, J1, J2, J3
52 DOUBLE PRECISION BIGNUM, CS, EPS, RES, SMLNUM, SN, SUM, TNRM,
53 $ WI1, WI2, WR1, WR2
54 * ..
55 * .. Local Arrays ..
56 DOUBLE PRECISION Q( 2, 2 ), T( 2, 2 ), T1( 2, 2 ), T2( 2, 2 ),
57 $ VAL( 4 ), VM( 3 )
58 * ..
59 * .. External Functions ..
60 DOUBLE PRECISION DLAMCH
61 EXTERNAL DLAMCH
62 * ..
63 * .. External Subroutines ..
64 EXTERNAL DLABAD, DLANV2
65 * ..
66 * .. Intrinsic Functions ..
67 INTRINSIC ABS, MAX, SIGN
68 * ..
69 * .. Executable Statements ..
70 *
71 * Get machine parameters
72 *
73 EPS = DLAMCH( 'P' )
74 SMLNUM = DLAMCH( 'S' ) / EPS
75 BIGNUM = ONE / SMLNUM
76 CALL DLABAD( SMLNUM, BIGNUM )
77 *
78 * Set up test case parameters
79 *
80 VAL( 1 ) = ONE
81 VAL( 2 ) = ONE + TWO*EPS
82 VAL( 3 ) = TWO
83 VAL( 4 ) = TWO - FOUR*EPS
84 VM( 1 ) = SMLNUM
85 VM( 2 ) = ONE
86 VM( 3 ) = BIGNUM
87 *
88 KNT = 0
89 NINFO = 0
90 LMAX = 0
91 RMAX = ZERO
92 *
93 * Begin test loop
94 *
95 DO 150 I1 = 1, 4
96 DO 140 I2 = 1, 4
97 DO 130 I3 = 1, 4
98 DO 120 I4 = 1, 4
99 DO 110 IM1 = 1, 3
100 DO 100 IM2 = 1, 3
101 DO 90 IM3 = 1, 3
102 DO 80 IM4 = 1, 3
103 T( 1, 1 ) = VAL( I1 )*VM( IM1 )
104 T( 1, 2 ) = VAL( I2 )*VM( IM2 )
105 T( 2, 1 ) = -VAL( I3 )*VM( IM3 )
106 T( 2, 2 ) = VAL( I4 )*VM( IM4 )
107 TNRM = MAX( ABS( T( 1, 1 ) ),
108 $ ABS( T( 1, 2 ) ), ABS( T( 2, 1 ) ),
109 $ ABS( T( 2, 2 ) ) )
110 T1( 1, 1 ) = T( 1, 1 )
111 T1( 1, 2 ) = T( 1, 2 )
112 T1( 2, 1 ) = T( 2, 1 )
113 T1( 2, 2 ) = T( 2, 2 )
114 Q( 1, 1 ) = ONE
115 Q( 1, 2 ) = ZERO
116 Q( 2, 1 ) = ZERO
117 Q( 2, 2 ) = ONE
118 *
119 CALL DLANV2( T( 1, 1 ), T( 1, 2 ),
120 $ T( 2, 1 ), T( 2, 2 ), WR1,
121 $ WI1, WR2, WI2, CS, SN )
122 DO 10 J1 = 1, 2
123 RES = Q( J1, 1 )*CS + Q( J1, 2 )*SN
124 Q( J1, 2 ) = -Q( J1, 1 )*SN +
125 $ Q( J1, 2 )*CS
126 Q( J1, 1 ) = RES
127 10 CONTINUE
128 *
129 RES = ZERO
130 RES = RES + ABS( Q( 1, 1 )**2+
131 $ Q( 1, 2 )**2-ONE ) / EPS
132 RES = RES + ABS( Q( 2, 2 )**2+
133 $ Q( 2, 1 )**2-ONE ) / EPS
134 RES = RES + ABS( Q( 1, 1 )*Q( 2, 1 )+
135 $ Q( 1, 2 )*Q( 2, 2 ) ) / EPS
136 DO 40 J1 = 1, 2
137 DO 30 J2 = 1, 2
138 T2( J1, J2 ) = ZERO
139 DO 20 J3 = 1, 2
140 T2( J1, J2 ) = T2( J1, J2 ) +
141 $ T1( J1, J3 )*
142 $ Q( J3, J2 )
143 20 CONTINUE
144 30 CONTINUE
145 40 CONTINUE
146 DO 70 J1 = 1, 2
147 DO 60 J2 = 1, 2
148 SUM = T( J1, J2 )
149 DO 50 J3 = 1, 2
150 SUM = SUM - Q( J3, J1 )*
151 $ T2( J3, J2 )
152 50 CONTINUE
153 RES = RES + ABS( SUM ) / EPS / TNRM
154 60 CONTINUE
155 70 CONTINUE
156 IF( T( 2, 1 ).NE.ZERO .AND.
157 $ ( T( 1, 1 ).NE.T( 2,
158 $ 2 ) .OR. SIGN( ONE, T( 1,
159 $ 2 ) )*SIGN( ONE, T( 2,
160 $ 1 ) ).GT.ZERO ) )RES = RES + ONE / EPS
161 KNT = KNT + 1
162 IF( RES.GT.RMAX ) THEN
163 LMAX = KNT
164 RMAX = RES
165 END IF
166 80 CONTINUE
167 90 CONTINUE
168 100 CONTINUE
169 110 CONTINUE
170 120 CONTINUE
171 130 CONTINUE
172 140 CONTINUE
173 150 CONTINUE
174 *
175 RETURN
176 *
177 * End of DGET33
178 *
179 END