1 SUBROUTINE DGET34( 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 DOUBLE PRECISION RMAX
10 * ..
11 * .. Array Arguments ..
12 INTEGER NINFO( 2 )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * DGET34 tests DLAEXC, 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, DLAEXC 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) DOUBLE PRECISION
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 DOUBLE PRECISION ZERO, HALF, ONE
52 PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
53 DOUBLE PRECISION TWO, THREE
54 PARAMETER ( TWO = 2.0D0, THREE = 3.0D0 )
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 DOUBLE PRECISION BIGNUM, EPS, RES, SMLNUM, TNRM
62 * ..
63 * .. Local Arrays ..
64 DOUBLE PRECISION Q( 4, 4 ), RESULT( 2 ), T( 4, 4 ), T1( 4, 4 ),
65 $ VAL( 9 ), VM( 2 ), WORK( LWORK )
66 * ..
67 * .. External Functions ..
68 DOUBLE PRECISION DLAMCH
69 EXTERNAL DLAMCH
70 * ..
71 * .. External Subroutines ..
72 EXTERNAL DCOPY, DHST01, DLABAD, DLAEXC
73 * ..
74 * .. Intrinsic Functions ..
75 INTRINSIC ABS, DBLE, MAX, SIGN, SQRT
76 * ..
77 * .. Executable Statements ..
78 *
79 * Get machine parameters
80 *
81 EPS = DLAMCH( 'P' )
82 SMLNUM = DLAMCH( 'S' ) / EPS
83 BIGNUM = ONE / SMLNUM
84 CALL DLABAD( 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 DCOPY( 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 DCOPY( 16, T, 1, T1, 1 )
120 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
121 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
122 CALL DLAEXC( .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 DHST01( 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 )*DBLE( 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 DCOPY( 16, T, 1, T1, 1 )
168 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
169 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
170 CALL DLAEXC( .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 DHST01( 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 )*DBLE( 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 DCOPY( 16, T, 1, T1, 1 )
224 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
225 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
226 CALL DLAEXC( .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 DHST01( 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 $ DBLE( 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 $ DBLE( 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 DCOPY( 16, T, 1, T1, 1 )
300 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
301 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
302 CALL DLAEXC( .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 DHST01( 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 DGET34
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 DOUBLE PRECISION RMAX
10 * ..
11 * .. Array Arguments ..
12 INTEGER NINFO( 2 )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * DGET34 tests DLAEXC, 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, DLAEXC 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) DOUBLE PRECISION
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 DOUBLE PRECISION ZERO, HALF, ONE
52 PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
53 DOUBLE PRECISION TWO, THREE
54 PARAMETER ( TWO = 2.0D0, THREE = 3.0D0 )
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 DOUBLE PRECISION BIGNUM, EPS, RES, SMLNUM, TNRM
62 * ..
63 * .. Local Arrays ..
64 DOUBLE PRECISION Q( 4, 4 ), RESULT( 2 ), T( 4, 4 ), T1( 4, 4 ),
65 $ VAL( 9 ), VM( 2 ), WORK( LWORK )
66 * ..
67 * .. External Functions ..
68 DOUBLE PRECISION DLAMCH
69 EXTERNAL DLAMCH
70 * ..
71 * .. External Subroutines ..
72 EXTERNAL DCOPY, DHST01, DLABAD, DLAEXC
73 * ..
74 * .. Intrinsic Functions ..
75 INTRINSIC ABS, DBLE, MAX, SIGN, SQRT
76 * ..
77 * .. Executable Statements ..
78 *
79 * Get machine parameters
80 *
81 EPS = DLAMCH( 'P' )
82 SMLNUM = DLAMCH( 'S' ) / EPS
83 BIGNUM = ONE / SMLNUM
84 CALL DLABAD( 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 DCOPY( 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 DCOPY( 16, T, 1, T1, 1 )
120 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
121 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
122 CALL DLAEXC( .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 DHST01( 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 )*DBLE( 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 DCOPY( 16, T, 1, T1, 1 )
168 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
169 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
170 CALL DLAEXC( .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 DHST01( 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 )*DBLE( 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 DCOPY( 16, T, 1, T1, 1 )
224 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
225 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
226 CALL DLAEXC( .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 DHST01( 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 $ DBLE( 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 $ DBLE( 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 DCOPY( 16, T, 1, T1, 1 )
300 CALL DCOPY( 16, VAL( 1 ), 0, Q, 1 )
301 CALL DCOPY( 4, VAL( 3 ), 0, Q, 5 )
302 CALL DLAEXC( .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 DHST01( 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 DGET34
351 *
352 END