1 SUBROUTINE ZDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
2 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
3 $ NOUT )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NOUT, NRHS
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 DOUBLE PRECISION RWORK( * )
18 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZDRVSY tests the driver routines ZSYSV and -SVX.
26 *
27 * Arguments
28 * =========
29 *
30 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
31 * The matrix types to be used for testing. Matrices of type j
32 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
33 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
34 *
35 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix dimension N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand side vectors to be generated for
43 * each linear system.
44 *
45 * THRESH (input) DOUBLE PRECISION
46 * The threshold value for the test ratios. A result is
47 * included in the output file if RESULT >= THRESH. To have
48 * every test ratio printed, use THRESH = 0.
49 *
50 * TSTERR (input) LOGICAL
51 * Flag that indicates whether error exits are to be tested.
52 *
53 * NMAX (input) INTEGER
54 * The maximum value permitted for N, used in dimensioning the
55 * work arrays.
56 *
57 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
58 *
59 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
60 *
61 * AINV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
62 *
63 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
64 *
65 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
66 *
67 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
68 *
69 * WORK (workspace) COMPLEX*16 array, dimension
70 * (NMAX*max(2,NRHS))
71 *
72 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
73 *
74 * IWORK (workspace) INTEGER array, dimension (NMAX)
75 *
76 * NOUT (input) INTEGER
77 * The unit number for output.
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82 DOUBLE PRECISION ONE, ZERO
83 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
84 INTEGER NTYPES, NTESTS
85 PARAMETER ( NTYPES = 11, NTESTS = 6 )
86 INTEGER NFACT
87 PARAMETER ( NFACT = 2 )
88 * ..
89 * .. Local Scalars ..
90 LOGICAL ZEROT
91 CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
92 CHARACTER*3 PATH
93 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
94 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
95 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
96 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC
97 * ..
98 * .. Local Arrays ..
99 CHARACTER FACTS( NFACT ), UPLOS( 2 )
100 INTEGER ISEED( 4 ), ISEEDY( 4 )
101 DOUBLE PRECISION RESULT( NTESTS )
102 * ..
103 * .. External Functions ..
104 DOUBLE PRECISION DGET06, ZLANSY
105 EXTERNAL DGET06, ZLANSY
106 * ..
107 * .. External Subroutines ..
108 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
109 $ ZLACPY, ZLARHS, ZLASET, ZLATB4, ZLATMS, ZLATSY,
110 $ ZPOT05, ZSYSV, ZSYSVX, ZSYT01, ZSYT02, ZSYTRF,
111 $ ZSYTRI2
112 * ..
113 * .. Scalars in Common ..
114 LOGICAL LERR, OK
115 CHARACTER*32 SRNAMT
116 INTEGER INFOT, NUNIT
117 * ..
118 * .. Common blocks ..
119 COMMON / INFOC / INFOT, NUNIT, OK, LERR
120 COMMON / SRNAMC / SRNAMT
121 * ..
122 * .. Intrinsic Functions ..
123 INTRINSIC DCMPLX, MAX, MIN
124 * ..
125 * .. Data statements ..
126 DATA ISEEDY / 1988, 1989, 1990, 1991 /
127 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
128 * ..
129 * .. Executable Statements ..
130 *
131 * Initialize constants and the random number seed.
132 *
133 PATH( 1: 1 ) = 'Zomplex precision'
134 PATH( 2: 3 ) = 'SY'
135 NRUN = 0
136 NFAIL = 0
137 NERRS = 0
138 DO 10 I = 1, 4
139 ISEED( I ) = ISEEDY( I )
140 10 CONTINUE
141 LWORK = MAX( 2*NMAX, NMAX*NRHS )
142 *
143 * Test the error exits
144 *
145 IF( TSTERR )
146 $ CALL ZERRVX( PATH, NOUT )
147 INFOT = 0
148 *
149 * Set the block size and minimum block size for testing.
150 *
151 NB = 1
152 NBMIN = 2
153 CALL XLAENV( 1, NB )
154 CALL XLAENV( 2, NBMIN )
155 *
156 * Do for each value of N in NVAL
157 *
158 DO 180 IN = 1, NN
159 N = NVAL( IN )
160 LDA = MAX( N, 1 )
161 XTYPE = 'N'
162 NIMAT = NTYPES
163 IF( N.LE.0 )
164 $ NIMAT = 1
165 *
166 DO 170 IMAT = 1, NIMAT
167 *
168 * Do the tests only if DOTYPE( IMAT ) is true.
169 *
170 IF( .NOT.DOTYPE( IMAT ) )
171 $ GO TO 170
172 *
173 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
174 *
175 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
176 IF( ZEROT .AND. N.LT.IMAT-2 )
177 $ GO TO 170
178 *
179 * Do first for UPLO = 'U', then for UPLO = 'L'
180 *
181 DO 160 IUPLO = 1, 2
182 UPLO = UPLOS( IUPLO )
183 *
184 IF( IMAT.NE.NTYPES ) THEN
185 *
186 * Set up parameters with ZLATB4 and generate a test
187 * matrix with ZLATMS.
188 *
189 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
190 $ MODE, CNDNUM, DIST )
191 *
192 SRNAMT = 'ZLATMS'
193 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
194 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
195 $ WORK, INFO )
196 *
197 * Check error code from ZLATMS.
198 *
199 IF( INFO.NE.0 ) THEN
200 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
201 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
202 GO TO 160
203 END IF
204 *
205 * For types 3-6, zero one or more rows and columns of
206 * the matrix to test that INFO is returned correctly.
207 *
208 IF( ZEROT ) THEN
209 IF( IMAT.EQ.3 ) THEN
210 IZERO = 1
211 ELSE IF( IMAT.EQ.4 ) THEN
212 IZERO = N
213 ELSE
214 IZERO = N / 2 + 1
215 END IF
216 *
217 IF( IMAT.LT.6 ) THEN
218 *
219 * Set row and column IZERO to zero.
220 *
221 IF( IUPLO.EQ.1 ) THEN
222 IOFF = ( IZERO-1 )*LDA
223 DO 20 I = 1, IZERO - 1
224 A( IOFF+I ) = ZERO
225 20 CONTINUE
226 IOFF = IOFF + IZERO
227 DO 30 I = IZERO, N
228 A( IOFF ) = ZERO
229 IOFF = IOFF + LDA
230 30 CONTINUE
231 ELSE
232 IOFF = IZERO
233 DO 40 I = 1, IZERO - 1
234 A( IOFF ) = ZERO
235 IOFF = IOFF + LDA
236 40 CONTINUE
237 IOFF = IOFF - IZERO
238 DO 50 I = IZERO, N
239 A( IOFF+I ) = ZERO
240 50 CONTINUE
241 END IF
242 ELSE
243 IF( IUPLO.EQ.1 ) THEN
244 *
245 * Set the first IZERO rows to zero.
246 *
247 IOFF = 0
248 DO 70 J = 1, N
249 I2 = MIN( J, IZERO )
250 DO 60 I = 1, I2
251 A( IOFF+I ) = ZERO
252 60 CONTINUE
253 IOFF = IOFF + LDA
254 70 CONTINUE
255 ELSE
256 *
257 * Set the last IZERO rows to zero.
258 *
259 IOFF = 0
260 DO 90 J = 1, N
261 I1 = MAX( J, IZERO )
262 DO 80 I = I1, N
263 A( IOFF+I ) = ZERO
264 80 CONTINUE
265 IOFF = IOFF + LDA
266 90 CONTINUE
267 END IF
268 END IF
269 ELSE
270 IZERO = 0
271 END IF
272 ELSE
273 *
274 * IMAT = NTYPES: Use a special block diagonal matrix to
275 * test alternate code for the 2-by-2 blocks.
276 *
277 CALL ZLATSY( UPLO, N, A, LDA, ISEED )
278 END IF
279 *
280 DO 150 IFACT = 1, NFACT
281 *
282 * Do first for FACT = 'F', then for other values.
283 *
284 FACT = FACTS( IFACT )
285 *
286 * Compute the condition number for comparison with
287 * the value returned by ZSYSVX.
288 *
289 IF( ZEROT ) THEN
290 IF( IFACT.EQ.1 )
291 $ GO TO 150
292 RCONDC = ZERO
293 *
294 ELSE IF( IFACT.EQ.1 ) THEN
295 *
296 * Compute the 1-norm of A.
297 *
298 ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
299 *
300 * Factor the matrix A.
301 *
302 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
303 CALL ZSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
304 $ LWORK, INFO )
305 *
306 * Compute inv(A) and take its norm.
307 *
308 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
309 LWORK = (N+NB+1)*(NB+3)
310 CALL ZSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
311 $ LWORK, INFO )
312 AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK )
313 *
314 * Compute the 1-norm condition number of A.
315 *
316 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
317 RCONDC = ONE
318 ELSE
319 RCONDC = ( ONE / ANORM ) / AINVNM
320 END IF
321 END IF
322 *
323 * Form an exact solution and set the right hand side.
324 *
325 SRNAMT = 'ZLARHS'
326 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
327 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
328 $ INFO )
329 XTYPE = 'C'
330 *
331 * --- Test ZSYSV ---
332 *
333 IF( IFACT.EQ.2 ) THEN
334 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
335 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
336 *
337 * Factor the matrix and solve the system using ZSYSV.
338 *
339 SRNAMT = 'ZSYSV '
340 CALL ZSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
341 $ LDA, WORK, LWORK, INFO )
342 *
343 * Adjust the expected value of INFO to account for
344 * pivoting.
345 *
346 K = IZERO
347 IF( K.GT.0 ) THEN
348 100 CONTINUE
349 IF( IWORK( K ).LT.0 ) THEN
350 IF( IWORK( K ).NE.-K ) THEN
351 K = -IWORK( K )
352 GO TO 100
353 END IF
354 ELSE IF( IWORK( K ).NE.K ) THEN
355 K = IWORK( K )
356 GO TO 100
357 END IF
358 END IF
359 *
360 * Check error code from ZSYSV .
361 *
362 IF( INFO.NE.K ) THEN
363 CALL ALAERH( PATH, 'ZSYSV ', INFO, K, UPLO, N,
364 $ N, -1, -1, NRHS, IMAT, NFAIL,
365 $ NERRS, NOUT )
366 GO TO 120
367 ELSE IF( INFO.NE.0 ) THEN
368 GO TO 120
369 END IF
370 *
371 * Reconstruct matrix from factors and compute
372 * residual.
373 *
374 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
375 $ AINV, LDA, RWORK, RESULT( 1 ) )
376 *
377 * Compute residual of the computed solution.
378 *
379 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
380 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
381 $ LDA, RWORK, RESULT( 2 ) )
382 *
383 * Check solution from generated exact solution.
384 *
385 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
386 $ RESULT( 3 ) )
387 NT = 3
388 *
389 * Print information about the tests that did not pass
390 * the threshold.
391 *
392 DO 110 K = 1, NT
393 IF( RESULT( K ).GE.THRESH ) THEN
394 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
395 $ CALL ALADHD( NOUT, PATH )
396 WRITE( NOUT, FMT = 9999 )'ZSYSV ', UPLO, N,
397 $ IMAT, K, RESULT( K )
398 NFAIL = NFAIL + 1
399 END IF
400 110 CONTINUE
401 NRUN = NRUN + NT
402 120 CONTINUE
403 END IF
404 *
405 * --- Test ZSYSVX ---
406 *
407 IF( IFACT.EQ.2 )
408 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
409 $ DCMPLX( ZERO ), AFAC, LDA )
410 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
411 $ DCMPLX( ZERO ), X, LDA )
412 *
413 * Solve the system and compute the condition number and
414 * error bounds using ZSYSVX.
415 *
416 SRNAMT = 'ZSYSVX'
417 CALL ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
418 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
419 $ RWORK( NRHS+1 ), WORK, LWORK,
420 $ RWORK( 2*NRHS+1 ), INFO )
421 *
422 * Adjust the expected value of INFO to account for
423 * pivoting.
424 *
425 K = IZERO
426 IF( K.GT.0 ) THEN
427 130 CONTINUE
428 IF( IWORK( K ).LT.0 ) THEN
429 IF( IWORK( K ).NE.-K ) THEN
430 K = -IWORK( K )
431 GO TO 130
432 END IF
433 ELSE IF( IWORK( K ).NE.K ) THEN
434 K = IWORK( K )
435 GO TO 130
436 END IF
437 END IF
438 *
439 * Check the error code from ZSYSVX.
440 *
441 IF( INFO.NE.K ) THEN
442 CALL ALAERH( PATH, 'ZSYSVX', INFO, K, FACT // UPLO,
443 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
444 $ NERRS, NOUT )
445 GO TO 150
446 END IF
447 *
448 IF( INFO.EQ.0 ) THEN
449 IF( IFACT.GE.2 ) THEN
450 *
451 * Reconstruct matrix from factors and compute
452 * residual.
453 *
454 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
455 $ AINV, LDA, RWORK( 2*NRHS+1 ),
456 $ RESULT( 1 ) )
457 K1 = 1
458 ELSE
459 K1 = 2
460 END IF
461 *
462 * Compute residual of the computed solution.
463 *
464 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
465 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
466 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
467 *
468 * Check solution from generated exact solution.
469 *
470 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
471 $ RESULT( 3 ) )
472 *
473 * Check the error bounds from iterative refinement.
474 *
475 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
476 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
477 $ RESULT( 4 ) )
478 ELSE
479 K1 = 6
480 END IF
481 *
482 * Compare RCOND from ZSYSVX with the computed value
483 * in RCONDC.
484 *
485 RESULT( 6 ) = DGET06( RCOND, RCONDC )
486 *
487 * Print information about the tests that did not pass
488 * the threshold.
489 *
490 DO 140 K = K1, 6
491 IF( RESULT( K ).GE.THRESH ) THEN
492 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
493 $ CALL ALADHD( NOUT, PATH )
494 WRITE( NOUT, FMT = 9998 )'ZSYSVX', FACT, UPLO,
495 $ N, IMAT, K, RESULT( K )
496 NFAIL = NFAIL + 1
497 END IF
498 140 CONTINUE
499 NRUN = NRUN + 7 - K1
500 *
501 150 CONTINUE
502 *
503 160 CONTINUE
504 170 CONTINUE
505 180 CONTINUE
506 *
507 * Print a summary of the results.
508 *
509 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
510 *
511 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
512 $ ', test ', I2, ', ratio =', G12.5 )
513 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
514 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
515 RETURN
516 *
517 * End of ZDRVSY
518 *
519 END
2 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
3 $ NOUT )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NOUT, NRHS
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 DOUBLE PRECISION RWORK( * )
18 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZDRVSY tests the driver routines ZSYSV and -SVX.
26 *
27 * Arguments
28 * =========
29 *
30 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
31 * The matrix types to be used for testing. Matrices of type j
32 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
33 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
34 *
35 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix dimension N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand side vectors to be generated for
43 * each linear system.
44 *
45 * THRESH (input) DOUBLE PRECISION
46 * The threshold value for the test ratios. A result is
47 * included in the output file if RESULT >= THRESH. To have
48 * every test ratio printed, use THRESH = 0.
49 *
50 * TSTERR (input) LOGICAL
51 * Flag that indicates whether error exits are to be tested.
52 *
53 * NMAX (input) INTEGER
54 * The maximum value permitted for N, used in dimensioning the
55 * work arrays.
56 *
57 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
58 *
59 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
60 *
61 * AINV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
62 *
63 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
64 *
65 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
66 *
67 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
68 *
69 * WORK (workspace) COMPLEX*16 array, dimension
70 * (NMAX*max(2,NRHS))
71 *
72 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
73 *
74 * IWORK (workspace) INTEGER array, dimension (NMAX)
75 *
76 * NOUT (input) INTEGER
77 * The unit number for output.
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82 DOUBLE PRECISION ONE, ZERO
83 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
84 INTEGER NTYPES, NTESTS
85 PARAMETER ( NTYPES = 11, NTESTS = 6 )
86 INTEGER NFACT
87 PARAMETER ( NFACT = 2 )
88 * ..
89 * .. Local Scalars ..
90 LOGICAL ZEROT
91 CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
92 CHARACTER*3 PATH
93 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
94 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
95 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
96 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC
97 * ..
98 * .. Local Arrays ..
99 CHARACTER FACTS( NFACT ), UPLOS( 2 )
100 INTEGER ISEED( 4 ), ISEEDY( 4 )
101 DOUBLE PRECISION RESULT( NTESTS )
102 * ..
103 * .. External Functions ..
104 DOUBLE PRECISION DGET06, ZLANSY
105 EXTERNAL DGET06, ZLANSY
106 * ..
107 * .. External Subroutines ..
108 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
109 $ ZLACPY, ZLARHS, ZLASET, ZLATB4, ZLATMS, ZLATSY,
110 $ ZPOT05, ZSYSV, ZSYSVX, ZSYT01, ZSYT02, ZSYTRF,
111 $ ZSYTRI2
112 * ..
113 * .. Scalars in Common ..
114 LOGICAL LERR, OK
115 CHARACTER*32 SRNAMT
116 INTEGER INFOT, NUNIT
117 * ..
118 * .. Common blocks ..
119 COMMON / INFOC / INFOT, NUNIT, OK, LERR
120 COMMON / SRNAMC / SRNAMT
121 * ..
122 * .. Intrinsic Functions ..
123 INTRINSIC DCMPLX, MAX, MIN
124 * ..
125 * .. Data statements ..
126 DATA ISEEDY / 1988, 1989, 1990, 1991 /
127 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
128 * ..
129 * .. Executable Statements ..
130 *
131 * Initialize constants and the random number seed.
132 *
133 PATH( 1: 1 ) = 'Zomplex precision'
134 PATH( 2: 3 ) = 'SY'
135 NRUN = 0
136 NFAIL = 0
137 NERRS = 0
138 DO 10 I = 1, 4
139 ISEED( I ) = ISEEDY( I )
140 10 CONTINUE
141 LWORK = MAX( 2*NMAX, NMAX*NRHS )
142 *
143 * Test the error exits
144 *
145 IF( TSTERR )
146 $ CALL ZERRVX( PATH, NOUT )
147 INFOT = 0
148 *
149 * Set the block size and minimum block size for testing.
150 *
151 NB = 1
152 NBMIN = 2
153 CALL XLAENV( 1, NB )
154 CALL XLAENV( 2, NBMIN )
155 *
156 * Do for each value of N in NVAL
157 *
158 DO 180 IN = 1, NN
159 N = NVAL( IN )
160 LDA = MAX( N, 1 )
161 XTYPE = 'N'
162 NIMAT = NTYPES
163 IF( N.LE.0 )
164 $ NIMAT = 1
165 *
166 DO 170 IMAT = 1, NIMAT
167 *
168 * Do the tests only if DOTYPE( IMAT ) is true.
169 *
170 IF( .NOT.DOTYPE( IMAT ) )
171 $ GO TO 170
172 *
173 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
174 *
175 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
176 IF( ZEROT .AND. N.LT.IMAT-2 )
177 $ GO TO 170
178 *
179 * Do first for UPLO = 'U', then for UPLO = 'L'
180 *
181 DO 160 IUPLO = 1, 2
182 UPLO = UPLOS( IUPLO )
183 *
184 IF( IMAT.NE.NTYPES ) THEN
185 *
186 * Set up parameters with ZLATB4 and generate a test
187 * matrix with ZLATMS.
188 *
189 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
190 $ MODE, CNDNUM, DIST )
191 *
192 SRNAMT = 'ZLATMS'
193 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
194 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
195 $ WORK, INFO )
196 *
197 * Check error code from ZLATMS.
198 *
199 IF( INFO.NE.0 ) THEN
200 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
201 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
202 GO TO 160
203 END IF
204 *
205 * For types 3-6, zero one or more rows and columns of
206 * the matrix to test that INFO is returned correctly.
207 *
208 IF( ZEROT ) THEN
209 IF( IMAT.EQ.3 ) THEN
210 IZERO = 1
211 ELSE IF( IMAT.EQ.4 ) THEN
212 IZERO = N
213 ELSE
214 IZERO = N / 2 + 1
215 END IF
216 *
217 IF( IMAT.LT.6 ) THEN
218 *
219 * Set row and column IZERO to zero.
220 *
221 IF( IUPLO.EQ.1 ) THEN
222 IOFF = ( IZERO-1 )*LDA
223 DO 20 I = 1, IZERO - 1
224 A( IOFF+I ) = ZERO
225 20 CONTINUE
226 IOFF = IOFF + IZERO
227 DO 30 I = IZERO, N
228 A( IOFF ) = ZERO
229 IOFF = IOFF + LDA
230 30 CONTINUE
231 ELSE
232 IOFF = IZERO
233 DO 40 I = 1, IZERO - 1
234 A( IOFF ) = ZERO
235 IOFF = IOFF + LDA
236 40 CONTINUE
237 IOFF = IOFF - IZERO
238 DO 50 I = IZERO, N
239 A( IOFF+I ) = ZERO
240 50 CONTINUE
241 END IF
242 ELSE
243 IF( IUPLO.EQ.1 ) THEN
244 *
245 * Set the first IZERO rows to zero.
246 *
247 IOFF = 0
248 DO 70 J = 1, N
249 I2 = MIN( J, IZERO )
250 DO 60 I = 1, I2
251 A( IOFF+I ) = ZERO
252 60 CONTINUE
253 IOFF = IOFF + LDA
254 70 CONTINUE
255 ELSE
256 *
257 * Set the last IZERO rows to zero.
258 *
259 IOFF = 0
260 DO 90 J = 1, N
261 I1 = MAX( J, IZERO )
262 DO 80 I = I1, N
263 A( IOFF+I ) = ZERO
264 80 CONTINUE
265 IOFF = IOFF + LDA
266 90 CONTINUE
267 END IF
268 END IF
269 ELSE
270 IZERO = 0
271 END IF
272 ELSE
273 *
274 * IMAT = NTYPES: Use a special block diagonal matrix to
275 * test alternate code for the 2-by-2 blocks.
276 *
277 CALL ZLATSY( UPLO, N, A, LDA, ISEED )
278 END IF
279 *
280 DO 150 IFACT = 1, NFACT
281 *
282 * Do first for FACT = 'F', then for other values.
283 *
284 FACT = FACTS( IFACT )
285 *
286 * Compute the condition number for comparison with
287 * the value returned by ZSYSVX.
288 *
289 IF( ZEROT ) THEN
290 IF( IFACT.EQ.1 )
291 $ GO TO 150
292 RCONDC = ZERO
293 *
294 ELSE IF( IFACT.EQ.1 ) THEN
295 *
296 * Compute the 1-norm of A.
297 *
298 ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
299 *
300 * Factor the matrix A.
301 *
302 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
303 CALL ZSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
304 $ LWORK, INFO )
305 *
306 * Compute inv(A) and take its norm.
307 *
308 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
309 LWORK = (N+NB+1)*(NB+3)
310 CALL ZSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
311 $ LWORK, INFO )
312 AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK )
313 *
314 * Compute the 1-norm condition number of A.
315 *
316 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
317 RCONDC = ONE
318 ELSE
319 RCONDC = ( ONE / ANORM ) / AINVNM
320 END IF
321 END IF
322 *
323 * Form an exact solution and set the right hand side.
324 *
325 SRNAMT = 'ZLARHS'
326 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
327 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
328 $ INFO )
329 XTYPE = 'C'
330 *
331 * --- Test ZSYSV ---
332 *
333 IF( IFACT.EQ.2 ) THEN
334 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
335 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
336 *
337 * Factor the matrix and solve the system using ZSYSV.
338 *
339 SRNAMT = 'ZSYSV '
340 CALL ZSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
341 $ LDA, WORK, LWORK, INFO )
342 *
343 * Adjust the expected value of INFO to account for
344 * pivoting.
345 *
346 K = IZERO
347 IF( K.GT.0 ) THEN
348 100 CONTINUE
349 IF( IWORK( K ).LT.0 ) THEN
350 IF( IWORK( K ).NE.-K ) THEN
351 K = -IWORK( K )
352 GO TO 100
353 END IF
354 ELSE IF( IWORK( K ).NE.K ) THEN
355 K = IWORK( K )
356 GO TO 100
357 END IF
358 END IF
359 *
360 * Check error code from ZSYSV .
361 *
362 IF( INFO.NE.K ) THEN
363 CALL ALAERH( PATH, 'ZSYSV ', INFO, K, UPLO, N,
364 $ N, -1, -1, NRHS, IMAT, NFAIL,
365 $ NERRS, NOUT )
366 GO TO 120
367 ELSE IF( INFO.NE.0 ) THEN
368 GO TO 120
369 END IF
370 *
371 * Reconstruct matrix from factors and compute
372 * residual.
373 *
374 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
375 $ AINV, LDA, RWORK, RESULT( 1 ) )
376 *
377 * Compute residual of the computed solution.
378 *
379 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
380 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
381 $ LDA, RWORK, RESULT( 2 ) )
382 *
383 * Check solution from generated exact solution.
384 *
385 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
386 $ RESULT( 3 ) )
387 NT = 3
388 *
389 * Print information about the tests that did not pass
390 * the threshold.
391 *
392 DO 110 K = 1, NT
393 IF( RESULT( K ).GE.THRESH ) THEN
394 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
395 $ CALL ALADHD( NOUT, PATH )
396 WRITE( NOUT, FMT = 9999 )'ZSYSV ', UPLO, N,
397 $ IMAT, K, RESULT( K )
398 NFAIL = NFAIL + 1
399 END IF
400 110 CONTINUE
401 NRUN = NRUN + NT
402 120 CONTINUE
403 END IF
404 *
405 * --- Test ZSYSVX ---
406 *
407 IF( IFACT.EQ.2 )
408 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
409 $ DCMPLX( ZERO ), AFAC, LDA )
410 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
411 $ DCMPLX( ZERO ), X, LDA )
412 *
413 * Solve the system and compute the condition number and
414 * error bounds using ZSYSVX.
415 *
416 SRNAMT = 'ZSYSVX'
417 CALL ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
418 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
419 $ RWORK( NRHS+1 ), WORK, LWORK,
420 $ RWORK( 2*NRHS+1 ), INFO )
421 *
422 * Adjust the expected value of INFO to account for
423 * pivoting.
424 *
425 K = IZERO
426 IF( K.GT.0 ) THEN
427 130 CONTINUE
428 IF( IWORK( K ).LT.0 ) THEN
429 IF( IWORK( K ).NE.-K ) THEN
430 K = -IWORK( K )
431 GO TO 130
432 END IF
433 ELSE IF( IWORK( K ).NE.K ) THEN
434 K = IWORK( K )
435 GO TO 130
436 END IF
437 END IF
438 *
439 * Check the error code from ZSYSVX.
440 *
441 IF( INFO.NE.K ) THEN
442 CALL ALAERH( PATH, 'ZSYSVX', INFO, K, FACT // UPLO,
443 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
444 $ NERRS, NOUT )
445 GO TO 150
446 END IF
447 *
448 IF( INFO.EQ.0 ) THEN
449 IF( IFACT.GE.2 ) THEN
450 *
451 * Reconstruct matrix from factors and compute
452 * residual.
453 *
454 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
455 $ AINV, LDA, RWORK( 2*NRHS+1 ),
456 $ RESULT( 1 ) )
457 K1 = 1
458 ELSE
459 K1 = 2
460 END IF
461 *
462 * Compute residual of the computed solution.
463 *
464 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
465 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
466 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
467 *
468 * Check solution from generated exact solution.
469 *
470 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
471 $ RESULT( 3 ) )
472 *
473 * Check the error bounds from iterative refinement.
474 *
475 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
476 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
477 $ RESULT( 4 ) )
478 ELSE
479 K1 = 6
480 END IF
481 *
482 * Compare RCOND from ZSYSVX with the computed value
483 * in RCONDC.
484 *
485 RESULT( 6 ) = DGET06( RCOND, RCONDC )
486 *
487 * Print information about the tests that did not pass
488 * the threshold.
489 *
490 DO 140 K = K1, 6
491 IF( RESULT( K ).GE.THRESH ) THEN
492 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
493 $ CALL ALADHD( NOUT, PATH )
494 WRITE( NOUT, FMT = 9998 )'ZSYSVX', FACT, UPLO,
495 $ N, IMAT, K, RESULT( K )
496 NFAIL = NFAIL + 1
497 END IF
498 140 CONTINUE
499 NRUN = NRUN + 7 - K1
500 *
501 150 CONTINUE
502 *
503 160 CONTINUE
504 170 CONTINUE
505 180 CONTINUE
506 *
507 * Print a summary of the results.
508 *
509 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
510 *
511 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
512 $ ', test ', I2, ', ratio =', G12.5 )
513 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
514 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
515 RETURN
516 *
517 * End of ZDRVSY
518 *
519 END