1 SUBROUTINE ZCHKEQ( THRESH, NOUT )
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 NOUT
9 DOUBLE PRECISION THRESH
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * ZCHKEQ tests ZGEEQU, ZGBEQU, ZPOEQU, ZPPEQU and ZPBEQU
16 *
17 * Arguments
18 * =========
19 *
20 * THRESH (input) DOUBLE PRECISION
21 * Threshold for testing routines. Should be between 2 and 10.
22 *
23 * NOUT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 DOUBLE PRECISION ZERO, ONE, TEN
30 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D+0, TEN = 1.0D1 )
31 COMPLEX*16 CZERO
32 PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ) )
33 COMPLEX*16 CONE
34 PARAMETER ( CONE = ( 1.0D0, 0.0D0 ) )
35 INTEGER NSZ, NSZB
36 PARAMETER ( NSZ = 5, NSZB = 3*NSZ-2 )
37 INTEGER NSZP, NPOW
38 PARAMETER ( NSZP = ( NSZ*( NSZ+1 ) ) / 2,
39 $ NPOW = 2*NSZ+1 )
40 * ..
41 * .. Local Scalars ..
42 LOGICAL OK
43 CHARACTER*3 PATH
44 INTEGER I, INFO, J, KL, KU, M, N
45 DOUBLE PRECISION CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
46 * ..
47 * .. Local Arrays ..
48 DOUBLE PRECISION C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ),
49 $ RPOW( NPOW )
50 COMPLEX*16 A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP )
51 * ..
52 * .. External Functions ..
53 DOUBLE PRECISION DLAMCH
54 EXTERNAL DLAMCH
55 * ..
56 * .. External Subroutines ..
57 EXTERNAL ZGBEQU, ZGEEQU, ZPBEQU, ZPOEQU, ZPPEQU
58 * ..
59 * .. Intrinsic Functions ..
60 INTRINSIC ABS, MAX, MIN
61 * ..
62 * .. Executable Statements ..
63 *
64 PATH( 1: 1 ) = 'Zomplex precision'
65 PATH( 2: 3 ) = 'EQ'
66 *
67 EPS = DLAMCH( 'P' )
68 DO 10 I = 1, 5
69 RESLTS( I ) = ZERO
70 10 CONTINUE
71 DO 20 I = 1, NPOW
72 POW( I ) = TEN**( I-1 )
73 RPOW( I ) = ONE / POW( I )
74 20 CONTINUE
75 *
76 * Test ZGEEQU
77 *
78 DO 80 N = 0, NSZ
79 DO 70 M = 0, NSZ
80 *
81 DO 40 J = 1, NSZ
82 DO 30 I = 1, NSZ
83 IF( I.LE.M .AND. J.LE.N ) THEN
84 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
85 ELSE
86 A( I, J ) = CZERO
87 END IF
88 30 CONTINUE
89 40 CONTINUE
90 *
91 CALL ZGEEQU( M, N, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
92 *
93 IF( INFO.NE.0 ) THEN
94 RESLTS( 1 ) = ONE
95 ELSE
96 IF( N.NE.0 .AND. M.NE.0 ) THEN
97 RESLTS( 1 ) = MAX( RESLTS( 1 ),
98 $ ABS( ( RCOND-RPOW( M ) ) / RPOW( M ) ) )
99 RESLTS( 1 ) = MAX( RESLTS( 1 ),
100 $ ABS( ( CCOND-RPOW( N ) ) / RPOW( N ) ) )
101 RESLTS( 1 ) = MAX( RESLTS( 1 ),
102 $ ABS( ( NORM-POW( N+M+1 ) ) / POW( N+M+
103 $ 1 ) ) )
104 DO 50 I = 1, M
105 RESLTS( 1 ) = MAX( RESLTS( 1 ),
106 $ ABS( ( R( I )-RPOW( I+N+1 ) ) /
107 $ RPOW( I+N+1 ) ) )
108 50 CONTINUE
109 DO 60 J = 1, N
110 RESLTS( 1 ) = MAX( RESLTS( 1 ),
111 $ ABS( ( C( J )-POW( N-J+1 ) ) /
112 $ POW( N-J+1 ) ) )
113 60 CONTINUE
114 END IF
115 END IF
116 *
117 70 CONTINUE
118 80 CONTINUE
119 *
120 * Test with zero rows and columns
121 *
122 DO 90 J = 1, NSZ
123 A( MAX( NSZ-1, 1 ), J ) = CZERO
124 90 CONTINUE
125 CALL ZGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
126 IF( INFO.NE.MAX( NSZ-1, 1 ) )
127 $ RESLTS( 1 ) = ONE
128 *
129 DO 100 J = 1, NSZ
130 A( MAX( NSZ-1, 1 ), J ) = CONE
131 100 CONTINUE
132 DO 110 I = 1, NSZ
133 A( I, MAX( NSZ-1, 1 ) ) = CZERO
134 110 CONTINUE
135 CALL ZGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
136 IF( INFO.NE.NSZ+MAX( NSZ-1, 1 ) )
137 $ RESLTS( 1 ) = ONE
138 RESLTS( 1 ) = RESLTS( 1 ) / EPS
139 *
140 * Test ZGBEQU
141 *
142 DO 250 N = 0, NSZ
143 DO 240 M = 0, NSZ
144 DO 230 KL = 0, MAX( M-1, 0 )
145 DO 220 KU = 0, MAX( N-1, 0 )
146 *
147 DO 130 J = 1, NSZ
148 DO 120 I = 1, NSZB
149 AB( I, J ) = CZERO
150 120 CONTINUE
151 130 CONTINUE
152 DO 150 J = 1, N
153 DO 140 I = 1, M
154 IF( I.LE.MIN( M, J+KL ) .AND. I.GE.
155 $ MAX( 1, J-KU ) .AND. J.LE.N ) THEN
156 AB( KU+1+I-J, J ) = POW( I+J+1 )*
157 $ ( -1 )**( I+J )
158 END IF
159 140 CONTINUE
160 150 CONTINUE
161 *
162 CALL ZGBEQU( M, N, KL, KU, AB, NSZB, R, C, RCOND,
163 $ CCOND, NORM, INFO )
164 *
165 IF( INFO.NE.0 ) THEN
166 IF( .NOT.( ( N+KL.LT.M .AND. INFO.EQ.N+KL+1 ) .OR.
167 $ ( M+KU.LT.N .AND. INFO.EQ.2*M+KU+1 ) ) ) THEN
168 RESLTS( 2 ) = ONE
169 END IF
170 ELSE
171 IF( N.NE.0 .AND. M.NE.0 ) THEN
172 *
173 RCMIN = R( 1 )
174 RCMAX = R( 1 )
175 DO 160 I = 1, M
176 RCMIN = MIN( RCMIN, R( I ) )
177 RCMAX = MAX( RCMAX, R( I ) )
178 160 CONTINUE
179 RATIO = RCMIN / RCMAX
180 RESLTS( 2 ) = MAX( RESLTS( 2 ),
181 $ ABS( ( RCOND-RATIO ) / RATIO ) )
182 *
183 RCMIN = C( 1 )
184 RCMAX = C( 1 )
185 DO 170 J = 1, N
186 RCMIN = MIN( RCMIN, C( J ) )
187 RCMAX = MAX( RCMAX, C( J ) )
188 170 CONTINUE
189 RATIO = RCMIN / RCMAX
190 RESLTS( 2 ) = MAX( RESLTS( 2 ),
191 $ ABS( ( CCOND-RATIO ) / RATIO ) )
192 *
193 RESLTS( 2 ) = MAX( RESLTS( 2 ),
194 $ ABS( ( NORM-POW( N+M+1 ) ) /
195 $ POW( N+M+1 ) ) )
196 DO 190 I = 1, M
197 RCMAX = ZERO
198 DO 180 J = 1, N
199 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
200 RATIO = ABS( R( I )*POW( I+J+1 )*
201 $ C( J ) )
202 RCMAX = MAX( RCMAX, RATIO )
203 END IF
204 180 CONTINUE
205 RESLTS( 2 ) = MAX( RESLTS( 2 ),
206 $ ABS( ONE-RCMAX ) )
207 190 CONTINUE
208 *
209 DO 210 J = 1, N
210 RCMAX = ZERO
211 DO 200 I = 1, M
212 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
213 RATIO = ABS( R( I )*POW( I+J+1 )*
214 $ C( J ) )
215 RCMAX = MAX( RCMAX, RATIO )
216 END IF
217 200 CONTINUE
218 RESLTS( 2 ) = MAX( RESLTS( 2 ),
219 $ ABS( ONE-RCMAX ) )
220 210 CONTINUE
221 END IF
222 END IF
223 *
224 220 CONTINUE
225 230 CONTINUE
226 240 CONTINUE
227 250 CONTINUE
228 RESLTS( 2 ) = RESLTS( 2 ) / EPS
229 *
230 * Test ZPOEQU
231 *
232 DO 290 N = 0, NSZ
233 *
234 DO 270 I = 1, NSZ
235 DO 260 J = 1, NSZ
236 IF( I.LE.N .AND. J.EQ.I ) THEN
237 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
238 ELSE
239 A( I, J ) = CZERO
240 END IF
241 260 CONTINUE
242 270 CONTINUE
243 *
244 CALL ZPOEQU( N, A, NSZ, R, RCOND, NORM, INFO )
245 *
246 IF( INFO.NE.0 ) THEN
247 RESLTS( 3 ) = ONE
248 ELSE
249 IF( N.NE.0 ) THEN
250 RESLTS( 3 ) = MAX( RESLTS( 3 ),
251 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
252 RESLTS( 3 ) = MAX( RESLTS( 3 ),
253 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
254 $ 1 ) ) )
255 DO 280 I = 1, N
256 RESLTS( 3 ) = MAX( RESLTS( 3 ),
257 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
258 $ 1 ) ) )
259 280 CONTINUE
260 END IF
261 END IF
262 290 CONTINUE
263 A( MAX( NSZ-1, 1 ), MAX( NSZ-1, 1 ) ) = -CONE
264 CALL ZPOEQU( NSZ, A, NSZ, R, RCOND, NORM, INFO )
265 IF( INFO.NE.MAX( NSZ-1, 1 ) )
266 $ RESLTS( 3 ) = ONE
267 RESLTS( 3 ) = RESLTS( 3 ) / EPS
268 *
269 * Test ZPPEQU
270 *
271 DO 360 N = 0, NSZ
272 *
273 * Upper triangular packed storage
274 *
275 DO 300 I = 1, ( N*( N+1 ) ) / 2
276 AP( I ) = CZERO
277 300 CONTINUE
278 DO 310 I = 1, N
279 AP( ( I*( I+1 ) ) / 2 ) = POW( 2*I+1 )
280 310 CONTINUE
281 *
282 CALL ZPPEQU( 'U', N, AP, R, RCOND, NORM, INFO )
283 *
284 IF( INFO.NE.0 ) THEN
285 RESLTS( 4 ) = ONE
286 ELSE
287 IF( N.NE.0 ) THEN
288 RESLTS( 4 ) = MAX( RESLTS( 4 ),
289 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
290 RESLTS( 4 ) = MAX( RESLTS( 4 ),
291 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
292 $ 1 ) ) )
293 DO 320 I = 1, N
294 RESLTS( 4 ) = MAX( RESLTS( 4 ),
295 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
296 $ 1 ) ) )
297 320 CONTINUE
298 END IF
299 END IF
300 *
301 * Lower triangular packed storage
302 *
303 DO 330 I = 1, ( N*( N+1 ) ) / 2
304 AP( I ) = CZERO
305 330 CONTINUE
306 J = 1
307 DO 340 I = 1, N
308 AP( J ) = POW( 2*I+1 )
309 J = J + ( N-I+1 )
310 340 CONTINUE
311 *
312 CALL ZPPEQU( 'L', N, AP, R, RCOND, NORM, INFO )
313 *
314 IF( INFO.NE.0 ) THEN
315 RESLTS( 4 ) = ONE
316 ELSE
317 IF( N.NE.0 ) THEN
318 RESLTS( 4 ) = MAX( RESLTS( 4 ),
319 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
320 RESLTS( 4 ) = MAX( RESLTS( 4 ),
321 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
322 $ 1 ) ) )
323 DO 350 I = 1, N
324 RESLTS( 4 ) = MAX( RESLTS( 4 ),
325 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
326 $ 1 ) ) )
327 350 CONTINUE
328 END IF
329 END IF
330 *
331 360 CONTINUE
332 I = ( NSZ*( NSZ+1 ) ) / 2 - 2
333 AP( I ) = -CONE
334 CALL ZPPEQU( 'L', NSZ, AP, R, RCOND, NORM, INFO )
335 IF( INFO.NE.MAX( NSZ-1, 1 ) )
336 $ RESLTS( 4 ) = ONE
337 RESLTS( 4 ) = RESLTS( 4 ) / EPS
338 *
339 * Test ZPBEQU
340 *
341 DO 460 N = 0, NSZ
342 DO 450 KL = 0, MAX( N-1, 0 )
343 *
344 * Test upper triangular storage
345 *
346 DO 380 J = 1, NSZ
347 DO 370 I = 1, NSZB
348 AB( I, J ) = CZERO
349 370 CONTINUE
350 380 CONTINUE
351 DO 390 J = 1, N
352 AB( KL+1, J ) = POW( 2*J+1 )
353 390 CONTINUE
354 *
355 CALL ZPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
356 *
357 IF( INFO.NE.0 ) THEN
358 RESLTS( 5 ) = ONE
359 ELSE
360 IF( N.NE.0 ) THEN
361 RESLTS( 5 ) = MAX( RESLTS( 5 ),
362 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
363 RESLTS( 5 ) = MAX( RESLTS( 5 ),
364 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
365 $ 1 ) ) )
366 DO 400 I = 1, N
367 RESLTS( 5 ) = MAX( RESLTS( 5 ),
368 $ ABS( ( R( I )-RPOW( I+1 ) ) /
369 $ RPOW( I+1 ) ) )
370 400 CONTINUE
371 END IF
372 END IF
373 IF( N.NE.0 ) THEN
374 AB( KL+1, MAX( N-1, 1 ) ) = -CONE
375 CALL ZPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
376 IF( INFO.NE.MAX( N-1, 1 ) )
377 $ RESLTS( 5 ) = ONE
378 END IF
379 *
380 * Test lower triangular storage
381 *
382 DO 420 J = 1, NSZ
383 DO 410 I = 1, NSZB
384 AB( I, J ) = CZERO
385 410 CONTINUE
386 420 CONTINUE
387 DO 430 J = 1, N
388 AB( 1, J ) = POW( 2*J+1 )
389 430 CONTINUE
390 *
391 CALL ZPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
392 *
393 IF( INFO.NE.0 ) THEN
394 RESLTS( 5 ) = ONE
395 ELSE
396 IF( N.NE.0 ) THEN
397 RESLTS( 5 ) = MAX( RESLTS( 5 ),
398 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
399 RESLTS( 5 ) = MAX( RESLTS( 5 ),
400 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
401 $ 1 ) ) )
402 DO 440 I = 1, N
403 RESLTS( 5 ) = MAX( RESLTS( 5 ),
404 $ ABS( ( R( I )-RPOW( I+1 ) ) /
405 $ RPOW( I+1 ) ) )
406 440 CONTINUE
407 END IF
408 END IF
409 IF( N.NE.0 ) THEN
410 AB( 1, MAX( N-1, 1 ) ) = -CONE
411 CALL ZPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
412 IF( INFO.NE.MAX( N-1, 1 ) )
413 $ RESLTS( 5 ) = ONE
414 END IF
415 450 CONTINUE
416 460 CONTINUE
417 RESLTS( 5 ) = RESLTS( 5 ) / EPS
418 OK = ( RESLTS( 1 ).LE.THRESH ) .AND.
419 $ ( RESLTS( 2 ).LE.THRESH ) .AND.
420 $ ( RESLTS( 3 ).LE.THRESH ) .AND.
421 $ ( RESLTS( 4 ).LE.THRESH ) .AND. ( RESLTS( 5 ).LE.THRESH )
422 WRITE( NOUT, FMT = * )
423 IF( OK ) THEN
424 WRITE( NOUT, FMT = 9999 )PATH
425 ELSE
426 IF( RESLTS( 1 ).GT.THRESH )
427 $ WRITE( NOUT, FMT = 9998 )RESLTS( 1 ), THRESH
428 IF( RESLTS( 2 ).GT.THRESH )
429 $ WRITE( NOUT, FMT = 9997 )RESLTS( 2 ), THRESH
430 IF( RESLTS( 3 ).GT.THRESH )
431 $ WRITE( NOUT, FMT = 9996 )RESLTS( 3 ), THRESH
432 IF( RESLTS( 4 ).GT.THRESH )
433 $ WRITE( NOUT, FMT = 9995 )RESLTS( 4 ), THRESH
434 IF( RESLTS( 5 ).GT.THRESH )
435 $ WRITE( NOUT, FMT = 9994 )RESLTS( 5 ), THRESH
436 END IF
437 9999 FORMAT( 1X, 'All tests for ', A3,
438 $ ' routines passed the threshold' )
439 9998 FORMAT( ' ZGEEQU failed test with value ', D10.3, ' exceeding',
440 $ ' threshold ', D10.3 )
441 9997 FORMAT( ' ZGBEQU failed test with value ', D10.3, ' exceeding',
442 $ ' threshold ', D10.3 )
443 9996 FORMAT( ' ZPOEQU failed test with value ', D10.3, ' exceeding',
444 $ ' threshold ', D10.3 )
445 9995 FORMAT( ' ZPPEQU failed test with value ', D10.3, ' exceeding',
446 $ ' threshold ', D10.3 )
447 9994 FORMAT( ' ZPBEQU failed test with value ', D10.3, ' exceeding',
448 $ ' threshold ', D10.3 )
449 RETURN
450 *
451 * End of ZCHKEQ
452 *
453 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 NOUT
9 DOUBLE PRECISION THRESH
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * ZCHKEQ tests ZGEEQU, ZGBEQU, ZPOEQU, ZPPEQU and ZPBEQU
16 *
17 * Arguments
18 * =========
19 *
20 * THRESH (input) DOUBLE PRECISION
21 * Threshold for testing routines. Should be between 2 and 10.
22 *
23 * NOUT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 DOUBLE PRECISION ZERO, ONE, TEN
30 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D+0, TEN = 1.0D1 )
31 COMPLEX*16 CZERO
32 PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ) )
33 COMPLEX*16 CONE
34 PARAMETER ( CONE = ( 1.0D0, 0.0D0 ) )
35 INTEGER NSZ, NSZB
36 PARAMETER ( NSZ = 5, NSZB = 3*NSZ-2 )
37 INTEGER NSZP, NPOW
38 PARAMETER ( NSZP = ( NSZ*( NSZ+1 ) ) / 2,
39 $ NPOW = 2*NSZ+1 )
40 * ..
41 * .. Local Scalars ..
42 LOGICAL OK
43 CHARACTER*3 PATH
44 INTEGER I, INFO, J, KL, KU, M, N
45 DOUBLE PRECISION CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
46 * ..
47 * .. Local Arrays ..
48 DOUBLE PRECISION C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ),
49 $ RPOW( NPOW )
50 COMPLEX*16 A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP )
51 * ..
52 * .. External Functions ..
53 DOUBLE PRECISION DLAMCH
54 EXTERNAL DLAMCH
55 * ..
56 * .. External Subroutines ..
57 EXTERNAL ZGBEQU, ZGEEQU, ZPBEQU, ZPOEQU, ZPPEQU
58 * ..
59 * .. Intrinsic Functions ..
60 INTRINSIC ABS, MAX, MIN
61 * ..
62 * .. Executable Statements ..
63 *
64 PATH( 1: 1 ) = 'Zomplex precision'
65 PATH( 2: 3 ) = 'EQ'
66 *
67 EPS = DLAMCH( 'P' )
68 DO 10 I = 1, 5
69 RESLTS( I ) = ZERO
70 10 CONTINUE
71 DO 20 I = 1, NPOW
72 POW( I ) = TEN**( I-1 )
73 RPOW( I ) = ONE / POW( I )
74 20 CONTINUE
75 *
76 * Test ZGEEQU
77 *
78 DO 80 N = 0, NSZ
79 DO 70 M = 0, NSZ
80 *
81 DO 40 J = 1, NSZ
82 DO 30 I = 1, NSZ
83 IF( I.LE.M .AND. J.LE.N ) THEN
84 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
85 ELSE
86 A( I, J ) = CZERO
87 END IF
88 30 CONTINUE
89 40 CONTINUE
90 *
91 CALL ZGEEQU( M, N, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
92 *
93 IF( INFO.NE.0 ) THEN
94 RESLTS( 1 ) = ONE
95 ELSE
96 IF( N.NE.0 .AND. M.NE.0 ) THEN
97 RESLTS( 1 ) = MAX( RESLTS( 1 ),
98 $ ABS( ( RCOND-RPOW( M ) ) / RPOW( M ) ) )
99 RESLTS( 1 ) = MAX( RESLTS( 1 ),
100 $ ABS( ( CCOND-RPOW( N ) ) / RPOW( N ) ) )
101 RESLTS( 1 ) = MAX( RESLTS( 1 ),
102 $ ABS( ( NORM-POW( N+M+1 ) ) / POW( N+M+
103 $ 1 ) ) )
104 DO 50 I = 1, M
105 RESLTS( 1 ) = MAX( RESLTS( 1 ),
106 $ ABS( ( R( I )-RPOW( I+N+1 ) ) /
107 $ RPOW( I+N+1 ) ) )
108 50 CONTINUE
109 DO 60 J = 1, N
110 RESLTS( 1 ) = MAX( RESLTS( 1 ),
111 $ ABS( ( C( J )-POW( N-J+1 ) ) /
112 $ POW( N-J+1 ) ) )
113 60 CONTINUE
114 END IF
115 END IF
116 *
117 70 CONTINUE
118 80 CONTINUE
119 *
120 * Test with zero rows and columns
121 *
122 DO 90 J = 1, NSZ
123 A( MAX( NSZ-1, 1 ), J ) = CZERO
124 90 CONTINUE
125 CALL ZGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
126 IF( INFO.NE.MAX( NSZ-1, 1 ) )
127 $ RESLTS( 1 ) = ONE
128 *
129 DO 100 J = 1, NSZ
130 A( MAX( NSZ-1, 1 ), J ) = CONE
131 100 CONTINUE
132 DO 110 I = 1, NSZ
133 A( I, MAX( NSZ-1, 1 ) ) = CZERO
134 110 CONTINUE
135 CALL ZGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
136 IF( INFO.NE.NSZ+MAX( NSZ-1, 1 ) )
137 $ RESLTS( 1 ) = ONE
138 RESLTS( 1 ) = RESLTS( 1 ) / EPS
139 *
140 * Test ZGBEQU
141 *
142 DO 250 N = 0, NSZ
143 DO 240 M = 0, NSZ
144 DO 230 KL = 0, MAX( M-1, 0 )
145 DO 220 KU = 0, MAX( N-1, 0 )
146 *
147 DO 130 J = 1, NSZ
148 DO 120 I = 1, NSZB
149 AB( I, J ) = CZERO
150 120 CONTINUE
151 130 CONTINUE
152 DO 150 J = 1, N
153 DO 140 I = 1, M
154 IF( I.LE.MIN( M, J+KL ) .AND. I.GE.
155 $ MAX( 1, J-KU ) .AND. J.LE.N ) THEN
156 AB( KU+1+I-J, J ) = POW( I+J+1 )*
157 $ ( -1 )**( I+J )
158 END IF
159 140 CONTINUE
160 150 CONTINUE
161 *
162 CALL ZGBEQU( M, N, KL, KU, AB, NSZB, R, C, RCOND,
163 $ CCOND, NORM, INFO )
164 *
165 IF( INFO.NE.0 ) THEN
166 IF( .NOT.( ( N+KL.LT.M .AND. INFO.EQ.N+KL+1 ) .OR.
167 $ ( M+KU.LT.N .AND. INFO.EQ.2*M+KU+1 ) ) ) THEN
168 RESLTS( 2 ) = ONE
169 END IF
170 ELSE
171 IF( N.NE.0 .AND. M.NE.0 ) THEN
172 *
173 RCMIN = R( 1 )
174 RCMAX = R( 1 )
175 DO 160 I = 1, M
176 RCMIN = MIN( RCMIN, R( I ) )
177 RCMAX = MAX( RCMAX, R( I ) )
178 160 CONTINUE
179 RATIO = RCMIN / RCMAX
180 RESLTS( 2 ) = MAX( RESLTS( 2 ),
181 $ ABS( ( RCOND-RATIO ) / RATIO ) )
182 *
183 RCMIN = C( 1 )
184 RCMAX = C( 1 )
185 DO 170 J = 1, N
186 RCMIN = MIN( RCMIN, C( J ) )
187 RCMAX = MAX( RCMAX, C( J ) )
188 170 CONTINUE
189 RATIO = RCMIN / RCMAX
190 RESLTS( 2 ) = MAX( RESLTS( 2 ),
191 $ ABS( ( CCOND-RATIO ) / RATIO ) )
192 *
193 RESLTS( 2 ) = MAX( RESLTS( 2 ),
194 $ ABS( ( NORM-POW( N+M+1 ) ) /
195 $ POW( N+M+1 ) ) )
196 DO 190 I = 1, M
197 RCMAX = ZERO
198 DO 180 J = 1, N
199 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
200 RATIO = ABS( R( I )*POW( I+J+1 )*
201 $ C( J ) )
202 RCMAX = MAX( RCMAX, RATIO )
203 END IF
204 180 CONTINUE
205 RESLTS( 2 ) = MAX( RESLTS( 2 ),
206 $ ABS( ONE-RCMAX ) )
207 190 CONTINUE
208 *
209 DO 210 J = 1, N
210 RCMAX = ZERO
211 DO 200 I = 1, M
212 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
213 RATIO = ABS( R( I )*POW( I+J+1 )*
214 $ C( J ) )
215 RCMAX = MAX( RCMAX, RATIO )
216 END IF
217 200 CONTINUE
218 RESLTS( 2 ) = MAX( RESLTS( 2 ),
219 $ ABS( ONE-RCMAX ) )
220 210 CONTINUE
221 END IF
222 END IF
223 *
224 220 CONTINUE
225 230 CONTINUE
226 240 CONTINUE
227 250 CONTINUE
228 RESLTS( 2 ) = RESLTS( 2 ) / EPS
229 *
230 * Test ZPOEQU
231 *
232 DO 290 N = 0, NSZ
233 *
234 DO 270 I = 1, NSZ
235 DO 260 J = 1, NSZ
236 IF( I.LE.N .AND. J.EQ.I ) THEN
237 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
238 ELSE
239 A( I, J ) = CZERO
240 END IF
241 260 CONTINUE
242 270 CONTINUE
243 *
244 CALL ZPOEQU( N, A, NSZ, R, RCOND, NORM, INFO )
245 *
246 IF( INFO.NE.0 ) THEN
247 RESLTS( 3 ) = ONE
248 ELSE
249 IF( N.NE.0 ) THEN
250 RESLTS( 3 ) = MAX( RESLTS( 3 ),
251 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
252 RESLTS( 3 ) = MAX( RESLTS( 3 ),
253 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
254 $ 1 ) ) )
255 DO 280 I = 1, N
256 RESLTS( 3 ) = MAX( RESLTS( 3 ),
257 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
258 $ 1 ) ) )
259 280 CONTINUE
260 END IF
261 END IF
262 290 CONTINUE
263 A( MAX( NSZ-1, 1 ), MAX( NSZ-1, 1 ) ) = -CONE
264 CALL ZPOEQU( NSZ, A, NSZ, R, RCOND, NORM, INFO )
265 IF( INFO.NE.MAX( NSZ-1, 1 ) )
266 $ RESLTS( 3 ) = ONE
267 RESLTS( 3 ) = RESLTS( 3 ) / EPS
268 *
269 * Test ZPPEQU
270 *
271 DO 360 N = 0, NSZ
272 *
273 * Upper triangular packed storage
274 *
275 DO 300 I = 1, ( N*( N+1 ) ) / 2
276 AP( I ) = CZERO
277 300 CONTINUE
278 DO 310 I = 1, N
279 AP( ( I*( I+1 ) ) / 2 ) = POW( 2*I+1 )
280 310 CONTINUE
281 *
282 CALL ZPPEQU( 'U', N, AP, R, RCOND, NORM, INFO )
283 *
284 IF( INFO.NE.0 ) THEN
285 RESLTS( 4 ) = ONE
286 ELSE
287 IF( N.NE.0 ) THEN
288 RESLTS( 4 ) = MAX( RESLTS( 4 ),
289 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
290 RESLTS( 4 ) = MAX( RESLTS( 4 ),
291 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
292 $ 1 ) ) )
293 DO 320 I = 1, N
294 RESLTS( 4 ) = MAX( RESLTS( 4 ),
295 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
296 $ 1 ) ) )
297 320 CONTINUE
298 END IF
299 END IF
300 *
301 * Lower triangular packed storage
302 *
303 DO 330 I = 1, ( N*( N+1 ) ) / 2
304 AP( I ) = CZERO
305 330 CONTINUE
306 J = 1
307 DO 340 I = 1, N
308 AP( J ) = POW( 2*I+1 )
309 J = J + ( N-I+1 )
310 340 CONTINUE
311 *
312 CALL ZPPEQU( 'L', N, AP, R, RCOND, NORM, INFO )
313 *
314 IF( INFO.NE.0 ) THEN
315 RESLTS( 4 ) = ONE
316 ELSE
317 IF( N.NE.0 ) THEN
318 RESLTS( 4 ) = MAX( RESLTS( 4 ),
319 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
320 RESLTS( 4 ) = MAX( RESLTS( 4 ),
321 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
322 $ 1 ) ) )
323 DO 350 I = 1, N
324 RESLTS( 4 ) = MAX( RESLTS( 4 ),
325 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
326 $ 1 ) ) )
327 350 CONTINUE
328 END IF
329 END IF
330 *
331 360 CONTINUE
332 I = ( NSZ*( NSZ+1 ) ) / 2 - 2
333 AP( I ) = -CONE
334 CALL ZPPEQU( 'L', NSZ, AP, R, RCOND, NORM, INFO )
335 IF( INFO.NE.MAX( NSZ-1, 1 ) )
336 $ RESLTS( 4 ) = ONE
337 RESLTS( 4 ) = RESLTS( 4 ) / EPS
338 *
339 * Test ZPBEQU
340 *
341 DO 460 N = 0, NSZ
342 DO 450 KL = 0, MAX( N-1, 0 )
343 *
344 * Test upper triangular storage
345 *
346 DO 380 J = 1, NSZ
347 DO 370 I = 1, NSZB
348 AB( I, J ) = CZERO
349 370 CONTINUE
350 380 CONTINUE
351 DO 390 J = 1, N
352 AB( KL+1, J ) = POW( 2*J+1 )
353 390 CONTINUE
354 *
355 CALL ZPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
356 *
357 IF( INFO.NE.0 ) THEN
358 RESLTS( 5 ) = ONE
359 ELSE
360 IF( N.NE.0 ) THEN
361 RESLTS( 5 ) = MAX( RESLTS( 5 ),
362 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
363 RESLTS( 5 ) = MAX( RESLTS( 5 ),
364 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
365 $ 1 ) ) )
366 DO 400 I = 1, N
367 RESLTS( 5 ) = MAX( RESLTS( 5 ),
368 $ ABS( ( R( I )-RPOW( I+1 ) ) /
369 $ RPOW( I+1 ) ) )
370 400 CONTINUE
371 END IF
372 END IF
373 IF( N.NE.0 ) THEN
374 AB( KL+1, MAX( N-1, 1 ) ) = -CONE
375 CALL ZPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
376 IF( INFO.NE.MAX( N-1, 1 ) )
377 $ RESLTS( 5 ) = ONE
378 END IF
379 *
380 * Test lower triangular storage
381 *
382 DO 420 J = 1, NSZ
383 DO 410 I = 1, NSZB
384 AB( I, J ) = CZERO
385 410 CONTINUE
386 420 CONTINUE
387 DO 430 J = 1, N
388 AB( 1, J ) = POW( 2*J+1 )
389 430 CONTINUE
390 *
391 CALL ZPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
392 *
393 IF( INFO.NE.0 ) THEN
394 RESLTS( 5 ) = ONE
395 ELSE
396 IF( N.NE.0 ) THEN
397 RESLTS( 5 ) = MAX( RESLTS( 5 ),
398 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
399 RESLTS( 5 ) = MAX( RESLTS( 5 ),
400 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
401 $ 1 ) ) )
402 DO 440 I = 1, N
403 RESLTS( 5 ) = MAX( RESLTS( 5 ),
404 $ ABS( ( R( I )-RPOW( I+1 ) ) /
405 $ RPOW( I+1 ) ) )
406 440 CONTINUE
407 END IF
408 END IF
409 IF( N.NE.0 ) THEN
410 AB( 1, MAX( N-1, 1 ) ) = -CONE
411 CALL ZPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
412 IF( INFO.NE.MAX( N-1, 1 ) )
413 $ RESLTS( 5 ) = ONE
414 END IF
415 450 CONTINUE
416 460 CONTINUE
417 RESLTS( 5 ) = RESLTS( 5 ) / EPS
418 OK = ( RESLTS( 1 ).LE.THRESH ) .AND.
419 $ ( RESLTS( 2 ).LE.THRESH ) .AND.
420 $ ( RESLTS( 3 ).LE.THRESH ) .AND.
421 $ ( RESLTS( 4 ).LE.THRESH ) .AND. ( RESLTS( 5 ).LE.THRESH )
422 WRITE( NOUT, FMT = * )
423 IF( OK ) THEN
424 WRITE( NOUT, FMT = 9999 )PATH
425 ELSE
426 IF( RESLTS( 1 ).GT.THRESH )
427 $ WRITE( NOUT, FMT = 9998 )RESLTS( 1 ), THRESH
428 IF( RESLTS( 2 ).GT.THRESH )
429 $ WRITE( NOUT, FMT = 9997 )RESLTS( 2 ), THRESH
430 IF( RESLTS( 3 ).GT.THRESH )
431 $ WRITE( NOUT, FMT = 9996 )RESLTS( 3 ), THRESH
432 IF( RESLTS( 4 ).GT.THRESH )
433 $ WRITE( NOUT, FMT = 9995 )RESLTS( 4 ), THRESH
434 IF( RESLTS( 5 ).GT.THRESH )
435 $ WRITE( NOUT, FMT = 9994 )RESLTS( 5 ), THRESH
436 END IF
437 9999 FORMAT( 1X, 'All tests for ', A3,
438 $ ' routines passed the threshold' )
439 9998 FORMAT( ' ZGEEQU failed test with value ', D10.3, ' exceeding',
440 $ ' threshold ', D10.3 )
441 9997 FORMAT( ' ZGBEQU failed test with value ', D10.3, ' exceeding',
442 $ ' threshold ', D10.3 )
443 9996 FORMAT( ' ZPOEQU failed test with value ', D10.3, ' exceeding',
444 $ ' threshold ', D10.3 )
445 9995 FORMAT( ' ZPPEQU failed test with value ', D10.3, ' exceeding',
446 $ ' threshold ', D10.3 )
447 9994 FORMAT( ' ZPBEQU failed test with value ', D10.3, ' exceeding',
448 $ ' threshold ', D10.3 )
449 RETURN
450 *
451 * End of ZCHKEQ
452 *
453 END