1 SUBROUTINE SGET34( 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
9 REAL RMAX
10 * ..
11 * .. Array Arguments ..
12 INTEGER NINFO( 2 )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SGET34 tests SLAEXC, a routine for swapping adjacent blocks (either
19 * 1 by 1 or 2 by 2) on the diagonal of a matrix in real Schur form.
20 * Thus, SLAEXC computes an orthogonal matrix Q such that
21 *
22 * Q' * [ A B ] * Q = [ C1 B1 ]
23 * [ 0 C ] [ 0 A1 ]
24 *
25 * where C1 is similar to C and A1 is similar to A. Both A and C are
26 * assumed to be in standard form (equal diagonal entries and
27 * offdiagonal with differing signs) and A1 and C1 are returned with the
28 * same properties.
29 *
30 * The test code verifies these last last assertions, as well as that
31 * the residual in the above equation is small.
32 *
33 * Arguments
34 * ==========
35 *
36 * RMAX (output) REAL
37 * Value of the largest test ratio.
38 *
39 * LMAX (output) INTEGER
40 * Example number where largest test ratio achieved.
41 *
42 * NINFO (output) INTEGER array, dimension (2)
43 * NINFO(J) is the number of examples where INFO=J occurred.
44 *
45 * KNT (output) INTEGER
46 * Total number of examples tested.
47 *
48 * =====================================================================
49 *
50 * .. Parameters ..
51 REAL ZERO, HALF, ONE
52 PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
53 REAL TWO, THREE
54 PARAMETER ( TWO = 2.0E0, THREE = 3.0E0 )
55 INTEGER LWORK
56 PARAMETER ( LWORK = 32 )
57 * ..
58 * .. Local Scalars ..
59 INTEGER I, IA, IA11, IA12, IA21, IA22, IAM, IB, IC,
60 $ IC11, IC12, IC21, IC22, ICM, INFO, J
61 REAL BIGNUM, EPS, RES, SMLNUM, TNRM
62 * ..
63 * .. Local Arrays ..
64 REAL Q( 4, 4 ), RESULT( 2 ), T( 4, 4 ), T1( 4, 4 ),
65 $ VAL( 9 ), VM( 2 ), WORK( LWORK )
66 * ..
67 * .. External Functions ..
68 REAL SLAMCH
69 EXTERNAL SLAMCH
70 * ..
71 * .. External Subroutines ..
72 EXTERNAL SCOPY, SLAEXC
73 * ..
74 * .. Intrinsic Functions ..
75 INTRINSIC ABS, MAX, REAL, SIGN, SQRT
76 * ..
77 * .. Executable Statements ..
78 *
79 * Get machine parameters
80 *
81 EPS = SLAMCH( 'P' )
82 SMLNUM = SLAMCH( 'S' ) / EPS
83 BIGNUM = ONE / SMLNUM
84 CALL SLABAD( SMLNUM, BIGNUM )
85 *
86 * Set up test case parameters
87 *
88 VAL( 1 ) = ZERO
89 VAL( 2 ) = SQRT( SMLNUM )
90 VAL( 3 ) = ONE
91 VAL( 4 ) = TWO
92 VAL( 5 ) = SQRT( BIGNUM )
93 VAL( 6 ) = -SQRT( SMLNUM )
94 VAL( 7 ) = -ONE
95 VAL( 8 ) = -TWO
96 VAL( 9 ) = -SQRT( BIGNUM )
97 VM( 1 ) = ONE
98 VM( 2 ) = ONE + TWO*EPS
99 CALL SCOPY( 16, VAL( 4 ), 0, T( 1, 1 ), 1 )
100 *
101 NINFO( 1 ) = 0
102 NINFO( 2 ) = 0
103 KNT = 0
104 LMAX = 0
105 RMAX = ZERO
106 *
107 * Begin test loop
108 *
109 DO 40 IA = 1, 9
110 DO 30 IAM = 1, 2
111 DO 20 IB = 1, 9
112 DO 10 IC = 1, 9
113 T( 1, 1 ) = VAL( IA )*VM( IAM )
114 T( 2, 2 ) = VAL( IC )
115 T( 1, 2 ) = VAL( IB )
116 T( 2, 1 ) = ZERO
117 TNRM = MAX( ABS( T( 1, 1 ) ), ABS( T( 2, 2 ) ),
118 $ ABS( T( 1, 2 ) ) )
119 CALL SCOPY( 16, T, 1, T1, 1 )
120 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
121 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
122 CALL SLAEXC( .TRUE., 2, T, 4, Q, 4, 1, 1, 1, WORK,
123 $ INFO )
124 IF( INFO.NE.0 )
125 $ NINFO( INFO ) = NINFO( INFO ) + 1
126 CALL SHST01( 2, 1, 2, T1, 4, T, 4, Q, 4, WORK, LWORK,
127 $ RESULT )
128 RES = RESULT( 1 ) + RESULT( 2 )
129 IF( INFO.NE.0 )
130 $ RES = RES + ONE / EPS
131 IF( T( 1, 1 ).NE.T1( 2, 2 ) )
132 $ RES = RES + ONE / EPS
133 IF( T( 2, 2 ).NE.T1( 1, 1 ) )
134 $ RES = RES + ONE / EPS
135 IF( T( 2, 1 ).NE.ZERO )
136 $ RES = RES + ONE / EPS
137 KNT = KNT + 1
138 IF( RES.GT.RMAX ) THEN
139 LMAX = KNT
140 RMAX = RES
141 END IF
142 10 CONTINUE
143 20 CONTINUE
144 30 CONTINUE
145 40 CONTINUE
146 *
147 DO 110 IA = 1, 5
148 DO 100 IAM = 1, 2
149 DO 90 IB = 1, 5
150 DO 80 IC11 = 1, 5
151 DO 70 IC12 = 2, 5
152 DO 60 IC21 = 2, 4
153 DO 50 IC22 = -1, 1, 2
154 T( 1, 1 ) = VAL( IA )*VM( IAM )
155 T( 1, 2 ) = VAL( IB )
156 T( 1, 3 ) = -TWO*VAL( IB )
157 T( 2, 1 ) = ZERO
158 T( 2, 2 ) = VAL( IC11 )
159 T( 2, 3 ) = VAL( IC12 )
160 T( 3, 1 ) = ZERO
161 T( 3, 2 ) = -VAL( IC21 )
162 T( 3, 3 ) = VAL( IC11 )*REAL( IC22 )
163 TNRM = MAX( ABS( T( 1, 1 ) ),
164 $ ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
165 $ ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
166 $ ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
167 CALL SCOPY( 16, T, 1, T1, 1 )
168 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
169 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
170 CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 1, 2,
171 $ WORK, INFO )
172 IF( INFO.NE.0 )
173 $ NINFO( INFO ) = NINFO( INFO ) + 1
174 CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
175 $ WORK, LWORK, RESULT )
176 RES = RESULT( 1 ) + RESULT( 2 )
177 IF( INFO.EQ.0 ) THEN
178 IF( T1( 1, 1 ).NE.T( 3, 3 ) )
179 $ RES = RES + ONE / EPS
180 IF( T( 3, 1 ).NE.ZERO )
181 $ RES = RES + ONE / EPS
182 IF( T( 3, 2 ).NE.ZERO )
183 $ RES = RES + ONE / EPS
184 IF( T( 2, 1 ).NE.0 .AND.
185 $ ( T( 1, 1 ).NE.T( 2,
186 $ 2 ) .OR. SIGN( ONE, T( 1,
187 $ 2 ) ).EQ.SIGN( ONE, T( 2, 1 ) ) ) )
188 $ RES = RES + ONE / EPS
189 END IF
190 KNT = KNT + 1
191 IF( RES.GT.RMAX ) THEN
192 LMAX = KNT
193 RMAX = RES
194 END IF
195 50 CONTINUE
196 60 CONTINUE
197 70 CONTINUE
198 80 CONTINUE
199 90 CONTINUE
200 100 CONTINUE
201 110 CONTINUE
202 *
203 DO 180 IA11 = 1, 5
204 DO 170 IA12 = 2, 5
205 DO 160 IA21 = 2, 4
206 DO 150 IA22 = -1, 1, 2
207 DO 140 ICM = 1, 2
208 DO 130 IB = 1, 5
209 DO 120 IC = 1, 5
210 T( 1, 1 ) = VAL( IA11 )
211 T( 1, 2 ) = VAL( IA12 )
212 T( 1, 3 ) = -TWO*VAL( IB )
213 T( 2, 1 ) = -VAL( IA21 )
214 T( 2, 2 ) = VAL( IA11 )*REAL( IA22 )
215 T( 2, 3 ) = VAL( IB )
216 T( 3, 1 ) = ZERO
217 T( 3, 2 ) = ZERO
218 T( 3, 3 ) = VAL( IC )*VM( ICM )
219 TNRM = MAX( ABS( T( 1, 1 ) ),
220 $ ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
221 $ ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
222 $ ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
223 CALL SCOPY( 16, T, 1, T1, 1 )
224 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
225 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
226 CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 2, 1,
227 $ WORK, INFO )
228 IF( INFO.NE.0 )
229 $ NINFO( INFO ) = NINFO( INFO ) + 1
230 CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
231 $ WORK, LWORK, RESULT )
232 RES = RESULT( 1 ) + RESULT( 2 )
233 IF( INFO.EQ.0 ) THEN
234 IF( T1( 3, 3 ).NE.T( 1, 1 ) )
235 $ RES = RES + ONE / EPS
236 IF( T( 2, 1 ).NE.ZERO )
237 $ RES = RES + ONE / EPS
238 IF( T( 3, 1 ).NE.ZERO )
239 $ RES = RES + ONE / EPS
240 IF( T( 3, 2 ).NE.0 .AND.
241 $ ( T( 2, 2 ).NE.T( 3,
242 $ 3 ) .OR. SIGN( ONE, T( 2,
243 $ 3 ) ).EQ.SIGN( ONE, T( 3, 2 ) ) ) )
244 $ RES = RES + ONE / EPS
245 END IF
246 KNT = KNT + 1
247 IF( RES.GT.RMAX ) THEN
248 LMAX = KNT
249 RMAX = RES
250 END IF
251 120 CONTINUE
252 130 CONTINUE
253 140 CONTINUE
254 150 CONTINUE
255 160 CONTINUE
256 170 CONTINUE
257 180 CONTINUE
258 *
259 DO 300 IA11 = 1, 5
260 DO 290 IA12 = 2, 5
261 DO 280 IA21 = 2, 4
262 DO 270 IA22 = -1, 1, 2
263 DO 260 IB = 1, 5
264 DO 250 IC11 = 3, 4
265 DO 240 IC12 = 3, 4
266 DO 230 IC21 = 3, 4
267 DO 220 IC22 = -1, 1, 2
268 DO 210 ICM = 5, 7
269 IAM = 1
270 T( 1, 1 ) = VAL( IA11 )*VM( IAM )
271 T( 1, 2 ) = VAL( IA12 )*VM( IAM )
272 T( 1, 3 ) = -TWO*VAL( IB )
273 T( 1, 4 ) = HALF*VAL( IB )
274 T( 2, 1 ) = -T( 1, 2 )*VAL( IA21 )
275 T( 2, 2 ) = VAL( IA11 )*
276 $ REAL( IA22 )*VM( IAM )
277 T( 2, 3 ) = VAL( IB )
278 T( 2, 4 ) = THREE*VAL( IB )
279 T( 3, 1 ) = ZERO
280 T( 3, 2 ) = ZERO
281 T( 3, 3 ) = VAL( IC11 )*
282 $ ABS( VAL( ICM ) )
283 T( 3, 4 ) = VAL( IC12 )*
284 $ ABS( VAL( ICM ) )
285 T( 4, 1 ) = ZERO
286 T( 4, 2 ) = ZERO
287 T( 4, 3 ) = -T( 3, 4 )*VAL( IC21 )*
288 $ ABS( VAL( ICM ) )
289 T( 4, 4 ) = VAL( IC11 )*
290 $ REAL( IC22 )*
291 $ ABS( VAL( ICM ) )
292 TNRM = ZERO
293 DO 200 I = 1, 4
294 DO 190 J = 1, 4
295 TNRM = MAX( TNRM,
296 $ ABS( T( I, J ) ) )
297 190 CONTINUE
298 200 CONTINUE
299 CALL SCOPY( 16, T, 1, T1, 1 )
300 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
301 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
302 CALL SLAEXC( .TRUE., 4, T, 4, Q, 4,
303 $ 1, 2, 2, WORK, INFO )
304 IF( INFO.NE.0 )
305 $ NINFO( INFO ) = NINFO( INFO ) + 1
306 CALL SHST01( 4, 1, 4, T1, 4, T, 4,
307 $ Q, 4, WORK, LWORK,
308 $ RESULT )
309 RES = RESULT( 1 ) + RESULT( 2 )
310 IF( INFO.EQ.0 ) THEN
311 IF( T( 3, 1 ).NE.ZERO )
312 $ RES = RES + ONE / EPS
313 IF( T( 4, 1 ).NE.ZERO )
314 $ RES = RES + ONE / EPS
315 IF( T( 3, 2 ).NE.ZERO )
316 $ RES = RES + ONE / EPS
317 IF( T( 4, 2 ).NE.ZERO )
318 $ RES = RES + ONE / EPS
319 IF( T( 2, 1 ).NE.0 .AND.
320 $ ( T( 1, 1 ).NE.T( 2,
321 $ 2 ) .OR. SIGN( ONE, T( 1,
322 $ 2 ) ).EQ.SIGN( ONE, T( 2,
323 $ 1 ) ) ) )RES = RES +
324 $ ONE / EPS
325 IF( T( 4, 3 ).NE.0 .AND.
326 $ ( T( 3, 3 ).NE.T( 4,
327 $ 4 ) .OR. SIGN( ONE, T( 3,
328 $ 4 ) ).EQ.SIGN( ONE, T( 4,
329 $ 3 ) ) ) )RES = RES +
330 $ ONE / EPS
331 END IF
332 KNT = KNT + 1
333 IF( RES.GT.RMAX ) THEN
334 LMAX = KNT
335 RMAX = RES
336 END IF
337 210 CONTINUE
338 220 CONTINUE
339 230 CONTINUE
340 240 CONTINUE
341 250 CONTINUE
342 260 CONTINUE
343 270 CONTINUE
344 280 CONTINUE
345 290 CONTINUE
346 300 CONTINUE
347 *
348 RETURN
349 *
350 * End of SGET34
351 *
352 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
9 REAL RMAX
10 * ..
11 * .. Array Arguments ..
12 INTEGER NINFO( 2 )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SGET34 tests SLAEXC, a routine for swapping adjacent blocks (either
19 * 1 by 1 or 2 by 2) on the diagonal of a matrix in real Schur form.
20 * Thus, SLAEXC computes an orthogonal matrix Q such that
21 *
22 * Q' * [ A B ] * Q = [ C1 B1 ]
23 * [ 0 C ] [ 0 A1 ]
24 *
25 * where C1 is similar to C and A1 is similar to A. Both A and C are
26 * assumed to be in standard form (equal diagonal entries and
27 * offdiagonal with differing signs) and A1 and C1 are returned with the
28 * same properties.
29 *
30 * The test code verifies these last last assertions, as well as that
31 * the residual in the above equation is small.
32 *
33 * Arguments
34 * ==========
35 *
36 * RMAX (output) REAL
37 * Value of the largest test ratio.
38 *
39 * LMAX (output) INTEGER
40 * Example number where largest test ratio achieved.
41 *
42 * NINFO (output) INTEGER array, dimension (2)
43 * NINFO(J) is the number of examples where INFO=J occurred.
44 *
45 * KNT (output) INTEGER
46 * Total number of examples tested.
47 *
48 * =====================================================================
49 *
50 * .. Parameters ..
51 REAL ZERO, HALF, ONE
52 PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
53 REAL TWO, THREE
54 PARAMETER ( TWO = 2.0E0, THREE = 3.0E0 )
55 INTEGER LWORK
56 PARAMETER ( LWORK = 32 )
57 * ..
58 * .. Local Scalars ..
59 INTEGER I, IA, IA11, IA12, IA21, IA22, IAM, IB, IC,
60 $ IC11, IC12, IC21, IC22, ICM, INFO, J
61 REAL BIGNUM, EPS, RES, SMLNUM, TNRM
62 * ..
63 * .. Local Arrays ..
64 REAL Q( 4, 4 ), RESULT( 2 ), T( 4, 4 ), T1( 4, 4 ),
65 $ VAL( 9 ), VM( 2 ), WORK( LWORK )
66 * ..
67 * .. External Functions ..
68 REAL SLAMCH
69 EXTERNAL SLAMCH
70 * ..
71 * .. External Subroutines ..
72 EXTERNAL SCOPY, SLAEXC
73 * ..
74 * .. Intrinsic Functions ..
75 INTRINSIC ABS, MAX, REAL, SIGN, SQRT
76 * ..
77 * .. Executable Statements ..
78 *
79 * Get machine parameters
80 *
81 EPS = SLAMCH( 'P' )
82 SMLNUM = SLAMCH( 'S' ) / EPS
83 BIGNUM = ONE / SMLNUM
84 CALL SLABAD( SMLNUM, BIGNUM )
85 *
86 * Set up test case parameters
87 *
88 VAL( 1 ) = ZERO
89 VAL( 2 ) = SQRT( SMLNUM )
90 VAL( 3 ) = ONE
91 VAL( 4 ) = TWO
92 VAL( 5 ) = SQRT( BIGNUM )
93 VAL( 6 ) = -SQRT( SMLNUM )
94 VAL( 7 ) = -ONE
95 VAL( 8 ) = -TWO
96 VAL( 9 ) = -SQRT( BIGNUM )
97 VM( 1 ) = ONE
98 VM( 2 ) = ONE + TWO*EPS
99 CALL SCOPY( 16, VAL( 4 ), 0, T( 1, 1 ), 1 )
100 *
101 NINFO( 1 ) = 0
102 NINFO( 2 ) = 0
103 KNT = 0
104 LMAX = 0
105 RMAX = ZERO
106 *
107 * Begin test loop
108 *
109 DO 40 IA = 1, 9
110 DO 30 IAM = 1, 2
111 DO 20 IB = 1, 9
112 DO 10 IC = 1, 9
113 T( 1, 1 ) = VAL( IA )*VM( IAM )
114 T( 2, 2 ) = VAL( IC )
115 T( 1, 2 ) = VAL( IB )
116 T( 2, 1 ) = ZERO
117 TNRM = MAX( ABS( T( 1, 1 ) ), ABS( T( 2, 2 ) ),
118 $ ABS( T( 1, 2 ) ) )
119 CALL SCOPY( 16, T, 1, T1, 1 )
120 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
121 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
122 CALL SLAEXC( .TRUE., 2, T, 4, Q, 4, 1, 1, 1, WORK,
123 $ INFO )
124 IF( INFO.NE.0 )
125 $ NINFO( INFO ) = NINFO( INFO ) + 1
126 CALL SHST01( 2, 1, 2, T1, 4, T, 4, Q, 4, WORK, LWORK,
127 $ RESULT )
128 RES = RESULT( 1 ) + RESULT( 2 )
129 IF( INFO.NE.0 )
130 $ RES = RES + ONE / EPS
131 IF( T( 1, 1 ).NE.T1( 2, 2 ) )
132 $ RES = RES + ONE / EPS
133 IF( T( 2, 2 ).NE.T1( 1, 1 ) )
134 $ RES = RES + ONE / EPS
135 IF( T( 2, 1 ).NE.ZERO )
136 $ RES = RES + ONE / EPS
137 KNT = KNT + 1
138 IF( RES.GT.RMAX ) THEN
139 LMAX = KNT
140 RMAX = RES
141 END IF
142 10 CONTINUE
143 20 CONTINUE
144 30 CONTINUE
145 40 CONTINUE
146 *
147 DO 110 IA = 1, 5
148 DO 100 IAM = 1, 2
149 DO 90 IB = 1, 5
150 DO 80 IC11 = 1, 5
151 DO 70 IC12 = 2, 5
152 DO 60 IC21 = 2, 4
153 DO 50 IC22 = -1, 1, 2
154 T( 1, 1 ) = VAL( IA )*VM( IAM )
155 T( 1, 2 ) = VAL( IB )
156 T( 1, 3 ) = -TWO*VAL( IB )
157 T( 2, 1 ) = ZERO
158 T( 2, 2 ) = VAL( IC11 )
159 T( 2, 3 ) = VAL( IC12 )
160 T( 3, 1 ) = ZERO
161 T( 3, 2 ) = -VAL( IC21 )
162 T( 3, 3 ) = VAL( IC11 )*REAL( IC22 )
163 TNRM = MAX( ABS( T( 1, 1 ) ),
164 $ ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
165 $ ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
166 $ ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
167 CALL SCOPY( 16, T, 1, T1, 1 )
168 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
169 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
170 CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 1, 2,
171 $ WORK, INFO )
172 IF( INFO.NE.0 )
173 $ NINFO( INFO ) = NINFO( INFO ) + 1
174 CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
175 $ WORK, LWORK, RESULT )
176 RES = RESULT( 1 ) + RESULT( 2 )
177 IF( INFO.EQ.0 ) THEN
178 IF( T1( 1, 1 ).NE.T( 3, 3 ) )
179 $ RES = RES + ONE / EPS
180 IF( T( 3, 1 ).NE.ZERO )
181 $ RES = RES + ONE / EPS
182 IF( T( 3, 2 ).NE.ZERO )
183 $ RES = RES + ONE / EPS
184 IF( T( 2, 1 ).NE.0 .AND.
185 $ ( T( 1, 1 ).NE.T( 2,
186 $ 2 ) .OR. SIGN( ONE, T( 1,
187 $ 2 ) ).EQ.SIGN( ONE, T( 2, 1 ) ) ) )
188 $ RES = RES + ONE / EPS
189 END IF
190 KNT = KNT + 1
191 IF( RES.GT.RMAX ) THEN
192 LMAX = KNT
193 RMAX = RES
194 END IF
195 50 CONTINUE
196 60 CONTINUE
197 70 CONTINUE
198 80 CONTINUE
199 90 CONTINUE
200 100 CONTINUE
201 110 CONTINUE
202 *
203 DO 180 IA11 = 1, 5
204 DO 170 IA12 = 2, 5
205 DO 160 IA21 = 2, 4
206 DO 150 IA22 = -1, 1, 2
207 DO 140 ICM = 1, 2
208 DO 130 IB = 1, 5
209 DO 120 IC = 1, 5
210 T( 1, 1 ) = VAL( IA11 )
211 T( 1, 2 ) = VAL( IA12 )
212 T( 1, 3 ) = -TWO*VAL( IB )
213 T( 2, 1 ) = -VAL( IA21 )
214 T( 2, 2 ) = VAL( IA11 )*REAL( IA22 )
215 T( 2, 3 ) = VAL( IB )
216 T( 3, 1 ) = ZERO
217 T( 3, 2 ) = ZERO
218 T( 3, 3 ) = VAL( IC )*VM( ICM )
219 TNRM = MAX( ABS( T( 1, 1 ) ),
220 $ ABS( T( 1, 2 ) ), ABS( T( 1, 3 ) ),
221 $ ABS( T( 2, 2 ) ), ABS( T( 2, 3 ) ),
222 $ ABS( T( 3, 2 ) ), ABS( T( 3, 3 ) ) )
223 CALL SCOPY( 16, T, 1, T1, 1 )
224 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
225 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
226 CALL SLAEXC( .TRUE., 3, T, 4, Q, 4, 1, 2, 1,
227 $ WORK, INFO )
228 IF( INFO.NE.0 )
229 $ NINFO( INFO ) = NINFO( INFO ) + 1
230 CALL SHST01( 3, 1, 3, T1, 4, T, 4, Q, 4,
231 $ WORK, LWORK, RESULT )
232 RES = RESULT( 1 ) + RESULT( 2 )
233 IF( INFO.EQ.0 ) THEN
234 IF( T1( 3, 3 ).NE.T( 1, 1 ) )
235 $ RES = RES + ONE / EPS
236 IF( T( 2, 1 ).NE.ZERO )
237 $ RES = RES + ONE / EPS
238 IF( T( 3, 1 ).NE.ZERO )
239 $ RES = RES + ONE / EPS
240 IF( T( 3, 2 ).NE.0 .AND.
241 $ ( T( 2, 2 ).NE.T( 3,
242 $ 3 ) .OR. SIGN( ONE, T( 2,
243 $ 3 ) ).EQ.SIGN( ONE, T( 3, 2 ) ) ) )
244 $ RES = RES + ONE / EPS
245 END IF
246 KNT = KNT + 1
247 IF( RES.GT.RMAX ) THEN
248 LMAX = KNT
249 RMAX = RES
250 END IF
251 120 CONTINUE
252 130 CONTINUE
253 140 CONTINUE
254 150 CONTINUE
255 160 CONTINUE
256 170 CONTINUE
257 180 CONTINUE
258 *
259 DO 300 IA11 = 1, 5
260 DO 290 IA12 = 2, 5
261 DO 280 IA21 = 2, 4
262 DO 270 IA22 = -1, 1, 2
263 DO 260 IB = 1, 5
264 DO 250 IC11 = 3, 4
265 DO 240 IC12 = 3, 4
266 DO 230 IC21 = 3, 4
267 DO 220 IC22 = -1, 1, 2
268 DO 210 ICM = 5, 7
269 IAM = 1
270 T( 1, 1 ) = VAL( IA11 )*VM( IAM )
271 T( 1, 2 ) = VAL( IA12 )*VM( IAM )
272 T( 1, 3 ) = -TWO*VAL( IB )
273 T( 1, 4 ) = HALF*VAL( IB )
274 T( 2, 1 ) = -T( 1, 2 )*VAL( IA21 )
275 T( 2, 2 ) = VAL( IA11 )*
276 $ REAL( IA22 )*VM( IAM )
277 T( 2, 3 ) = VAL( IB )
278 T( 2, 4 ) = THREE*VAL( IB )
279 T( 3, 1 ) = ZERO
280 T( 3, 2 ) = ZERO
281 T( 3, 3 ) = VAL( IC11 )*
282 $ ABS( VAL( ICM ) )
283 T( 3, 4 ) = VAL( IC12 )*
284 $ ABS( VAL( ICM ) )
285 T( 4, 1 ) = ZERO
286 T( 4, 2 ) = ZERO
287 T( 4, 3 ) = -T( 3, 4 )*VAL( IC21 )*
288 $ ABS( VAL( ICM ) )
289 T( 4, 4 ) = VAL( IC11 )*
290 $ REAL( IC22 )*
291 $ ABS( VAL( ICM ) )
292 TNRM = ZERO
293 DO 200 I = 1, 4
294 DO 190 J = 1, 4
295 TNRM = MAX( TNRM,
296 $ ABS( T( I, J ) ) )
297 190 CONTINUE
298 200 CONTINUE
299 CALL SCOPY( 16, T, 1, T1, 1 )
300 CALL SCOPY( 16, VAL( 1 ), 0, Q, 1 )
301 CALL SCOPY( 4, VAL( 3 ), 0, Q, 5 )
302 CALL SLAEXC( .TRUE., 4, T, 4, Q, 4,
303 $ 1, 2, 2, WORK, INFO )
304 IF( INFO.NE.0 )
305 $ NINFO( INFO ) = NINFO( INFO ) + 1
306 CALL SHST01( 4, 1, 4, T1, 4, T, 4,
307 $ Q, 4, WORK, LWORK,
308 $ RESULT )
309 RES = RESULT( 1 ) + RESULT( 2 )
310 IF( INFO.EQ.0 ) THEN
311 IF( T( 3, 1 ).NE.ZERO )
312 $ RES = RES + ONE / EPS
313 IF( T( 4, 1 ).NE.ZERO )
314 $ RES = RES + ONE / EPS
315 IF( T( 3, 2 ).NE.ZERO )
316 $ RES = RES + ONE / EPS
317 IF( T( 4, 2 ).NE.ZERO )
318 $ RES = RES + ONE / EPS
319 IF( T( 2, 1 ).NE.0 .AND.
320 $ ( T( 1, 1 ).NE.T( 2,
321 $ 2 ) .OR. SIGN( ONE, T( 1,
322 $ 2 ) ).EQ.SIGN( ONE, T( 2,
323 $ 1 ) ) ) )RES = RES +
324 $ ONE / EPS
325 IF( T( 4, 3 ).NE.0 .AND.
326 $ ( T( 3, 3 ).NE.T( 4,
327 $ 4 ) .OR. SIGN( ONE, T( 3,
328 $ 4 ) ).EQ.SIGN( ONE, T( 4,
329 $ 3 ) ) ) )RES = RES +
330 $ ONE / EPS
331 END IF
332 KNT = KNT + 1
333 IF( RES.GT.RMAX ) THEN
334 LMAX = KNT
335 RMAX = RES
336 END IF
337 210 CONTINUE
338 220 CONTINUE
339 230 CONTINUE
340 240 CONTINUE
341 250 CONTINUE
342 260 CONTINUE
343 270 CONTINUE
344 280 CONTINUE
345 290 CONTINUE
346 300 CONTINUE
347 *
348 RETURN
349 *
350 * End of SGET34
351 *
352 END