1 SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
2 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ RWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * April 2009
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 NVAL( * )
17 DOUBLE PRECISION RWORK( * ), S( * )
18 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
19 $ BSAV( * ), WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZDRVPO tests the driver routines ZPOSV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise zdrvpo.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) DOUBLE PRECISION
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * NMAX (input) INTEGER
57 * The maximum value permitted for N, used in dimensioning the
58 * work arrays.
59 *
60 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
61 *
62 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
63 *
64 * ASAV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
65 *
66 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
67 *
68 * BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
69 *
70 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
71 *
72 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
73 *
74 * S (workspace) DOUBLE PRECISION array, dimension (NMAX)
75 *
76 * WORK (workspace) COMPLEX*16 array, dimension
77 * (NMAX*max(3,NRHS))
78 *
79 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
80 *
81 * NOUT (input) INTEGER
82 * The unit number for output.
83 *
84 * =====================================================================
85 *
86 * .. Parameters ..
87 DOUBLE PRECISION ONE, ZERO
88 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
89 INTEGER NTYPES
90 PARAMETER ( NTYPES = 9 )
91 INTEGER NTESTS
92 PARAMETER ( NTESTS = 6 )
93 * ..
94 * .. Local Scalars ..
95 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
96 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
97 CHARACTER*3 PATH
98 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
99 $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN,
100 $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
101 $ N_ERR_BNDS
102 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
103 $ ROLDC, SCOND, RPVGRW_SVXX
104 * ..
105 * .. Local Arrays ..
106 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
107 INTEGER ISEED( 4 ), ISEEDY( 4 )
108 DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ),
109 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
110 * ..
111 * .. External Functions ..
112 LOGICAL LSAME
113 DOUBLE PRECISION DGET06, ZLANHE
114 EXTERNAL LSAME, DGET06, ZLANHE
115 * ..
116 * .. External Subroutines ..
117 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
118 $ ZLACPY, ZLAIPD, ZLAQHE, ZLARHS, ZLASET, ZLATB4,
119 $ ZLATMS, ZPOEQU, ZPOSV, ZPOSVX, ZPOT01, ZPOT02,
120 $ ZPOT05, ZPOTRF, ZPOTRI, ZPOSVXX
121 * ..
122 * .. Scalars in Common ..
123 LOGICAL LERR, OK
124 CHARACTER*32 SRNAMT
125 INTEGER INFOT, NUNIT
126 * ..
127 * .. Common blocks ..
128 COMMON / INFOC / INFOT, NUNIT, OK, LERR
129 COMMON / SRNAMC / SRNAMT
130 * ..
131 * .. Intrinsic Functions ..
132 INTRINSIC DCMPLX, MAX
133 * ..
134 * .. Data statements ..
135 DATA ISEEDY / 1988, 1989, 1990, 1991 /
136 DATA UPLOS / 'U', 'L' /
137 DATA FACTS / 'F', 'N', 'E' /
138 DATA EQUEDS / 'N', 'Y' /
139 * ..
140 * .. Executable Statements ..
141 *
142 * Initialize constants and the random number seed.
143 *
144 PATH( 1: 1 ) = 'Zomplex precision'
145 PATH( 2: 3 ) = 'PO'
146 NRUN = 0
147 NFAIL = 0
148 NERRS = 0
149 DO 10 I = 1, 4
150 ISEED( I ) = ISEEDY( I )
151 10 CONTINUE
152 *
153 * Test the error exits
154 *
155 IF( TSTERR )
156 $ CALL ZERRVX( PATH, NOUT )
157 INFOT = 0
158 *
159 * Set the block size and minimum block size for testing.
160 *
161 NB = 1
162 NBMIN = 2
163 CALL XLAENV( 1, NB )
164 CALL XLAENV( 2, NBMIN )
165 *
166 * Do for each value of N in NVAL
167 *
168 DO 130 IN = 1, NN
169 N = NVAL( IN )
170 LDA = MAX( N, 1 )
171 XTYPE = 'N'
172 NIMAT = NTYPES
173 IF( N.LE.0 )
174 $ NIMAT = 1
175 *
176 DO 120 IMAT = 1, NIMAT
177 *
178 * Do the tests only if DOTYPE( IMAT ) is true.
179 *
180 IF( .NOT.DOTYPE( IMAT ) )
181 $ GO TO 120
182 *
183 * Skip types 3, 4, or 5 if the matrix size is too small.
184 *
185 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
186 IF( ZEROT .AND. N.LT.IMAT-2 )
187 $ GO TO 120
188 *
189 * Do first for UPLO = 'U', then for UPLO = 'L'
190 *
191 DO 110 IUPLO = 1, 2
192 UPLO = UPLOS( IUPLO )
193 *
194 * Set up parameters with ZLATB4 and generate a test matrix
195 * with ZLATMS.
196 *
197 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
198 $ CNDNUM, DIST )
199 *
200 SRNAMT = 'ZLATMS'
201 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
202 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
203 $ INFO )
204 *
205 * Check error code from ZLATMS.
206 *
207 IF( INFO.NE.0 ) THEN
208 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
209 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
210 GO TO 110
211 END IF
212 *
213 * For types 3-5, zero one row and column of the matrix to
214 * test that INFO is returned correctly.
215 *
216 IF( ZEROT ) THEN
217 IF( IMAT.EQ.3 ) THEN
218 IZERO = 1
219 ELSE IF( IMAT.EQ.4 ) THEN
220 IZERO = N
221 ELSE
222 IZERO = N / 2 + 1
223 END IF
224 IOFF = ( IZERO-1 )*LDA
225 *
226 * Set row and column IZERO of A to 0.
227 *
228 IF( IUPLO.EQ.1 ) THEN
229 DO 20 I = 1, IZERO - 1
230 A( IOFF+I ) = ZERO
231 20 CONTINUE
232 IOFF = IOFF + IZERO
233 DO 30 I = IZERO, N
234 A( IOFF ) = ZERO
235 IOFF = IOFF + LDA
236 30 CONTINUE
237 ELSE
238 IOFF = IZERO
239 DO 40 I = 1, IZERO - 1
240 A( IOFF ) = ZERO
241 IOFF = IOFF + LDA
242 40 CONTINUE
243 IOFF = IOFF - IZERO
244 DO 50 I = IZERO, N
245 A( IOFF+I ) = ZERO
246 50 CONTINUE
247 END IF
248 ELSE
249 IZERO = 0
250 END IF
251 *
252 * Set the imaginary part of the diagonals.
253 *
254 CALL ZLAIPD( N, A, LDA+1, 0 )
255 *
256 * Save a copy of the matrix A in ASAV.
257 *
258 CALL ZLACPY( UPLO, N, N, A, LDA, ASAV, LDA )
259 *
260 DO 100 IEQUED = 1, 2
261 EQUED = EQUEDS( IEQUED )
262 IF( IEQUED.EQ.1 ) THEN
263 NFACT = 3
264 ELSE
265 NFACT = 1
266 END IF
267 *
268 DO 90 IFACT = 1, NFACT
269 FACT = FACTS( IFACT )
270 PREFAC = LSAME( FACT, 'F' )
271 NOFACT = LSAME( FACT, 'N' )
272 EQUIL = LSAME( FACT, 'E' )
273 *
274 IF( ZEROT ) THEN
275 IF( PREFAC )
276 $ GO TO 90
277 RCONDC = ZERO
278 *
279 ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN
280 *
281 * Compute the condition number for comparison with
282 * the value returned by ZPOSVX (FACT = 'N' reuses
283 * the condition number from the previous iteration
284 * with FACT = 'F').
285 *
286 CALL ZLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA )
287 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
288 *
289 * Compute row and column scale factors to
290 * equilibrate the matrix A.
291 *
292 CALL ZPOEQU( N, AFAC, LDA, S, SCOND, AMAX,
293 $ INFO )
294 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
295 IF( IEQUED.GT.1 )
296 $ SCOND = ZERO
297 *
298 * Equilibrate the matrix.
299 *
300 CALL ZLAQHE( UPLO, N, AFAC, LDA, S, SCOND,
301 $ AMAX, EQUED )
302 END IF
303 END IF
304 *
305 * Save the condition number of the
306 * non-equilibrated system for use in ZGET04.
307 *
308 IF( EQUIL )
309 $ ROLDC = RCONDC
310 *
311 * Compute the 1-norm of A.
312 *
313 ANORM = ZLANHE( '1', UPLO, N, AFAC, LDA, RWORK )
314 *
315 * Factor the matrix A.
316 *
317 CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO )
318 *
319 * Form the inverse of A.
320 *
321 CALL ZLACPY( UPLO, N, N, AFAC, LDA, A, LDA )
322 CALL ZPOTRI( UPLO, N, A, LDA, INFO )
323 *
324 * Compute the 1-norm condition number of A.
325 *
326 AINVNM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
327 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
328 RCONDC = ONE
329 ELSE
330 RCONDC = ( ONE / ANORM ) / AINVNM
331 END IF
332 END IF
333 *
334 * Restore the matrix A.
335 *
336 CALL ZLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
337 *
338 * Form an exact solution and set the right hand side.
339 *
340 SRNAMT = 'ZLARHS'
341 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
342 $ NRHS, A, LDA, XACT, LDA, B, LDA,
343 $ ISEED, INFO )
344 XTYPE = 'C'
345 CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
346 *
347 IF( NOFACT ) THEN
348 *
349 * --- Test ZPOSV ---
350 *
351 * Compute the L*L' or U'*U factorization of the
352 * matrix and solve the system.
353 *
354 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
355 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
356 *
357 SRNAMT = 'ZPOSV '
358 CALL ZPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA,
359 $ INFO )
360 *
361 * Check error code from ZPOSV .
362 *
363 IF( INFO.NE.IZERO ) THEN
364 CALL ALAERH( PATH, 'ZPOSV ', INFO, IZERO,
365 $ UPLO, N, N, -1, -1, NRHS, IMAT,
366 $ NFAIL, NERRS, NOUT )
367 GO TO 70
368 ELSE IF( INFO.NE.0 ) THEN
369 GO TO 70
370 END IF
371 *
372 * Reconstruct matrix from factors and compute
373 * residual.
374 *
375 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK,
376 $ RESULT( 1 ) )
377 *
378 * Compute residual of the computed solution.
379 *
380 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
381 $ LDA )
382 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
383 $ WORK, LDA, RWORK, RESULT( 2 ) )
384 *
385 * Check solution from generated exact solution.
386 *
387 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
388 $ RESULT( 3 ) )
389 NT = 3
390 *
391 * Print information about the tests that did not
392 * pass the threshold.
393 *
394 DO 60 K = 1, NT
395 IF( RESULT( K ).GE.THRESH ) THEN
396 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
397 $ CALL ALADHD( NOUT, PATH )
398 WRITE( NOUT, FMT = 9999 )'ZPOSV ', UPLO,
399 $ N, IMAT, K, RESULT( K )
400 NFAIL = NFAIL + 1
401 END IF
402 60 CONTINUE
403 NRUN = NRUN + NT
404 70 CONTINUE
405 END IF
406 *
407 * --- Test ZPOSVX ---
408 *
409 IF( .NOT.PREFAC )
410 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
411 $ DCMPLX( ZERO ), AFAC, LDA )
412 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
413 $ DCMPLX( ZERO ), X, LDA )
414 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
415 *
416 * Equilibrate the matrix if FACT='F' and
417 * EQUED='Y'.
418 *
419 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
420 $ EQUED )
421 END IF
422 *
423 * Solve the system and compute the condition number
424 * and error bounds using ZPOSVX.
425 *
426 SRNAMT = 'ZPOSVX'
427 CALL ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
428 $ LDA, EQUED, S, B, LDA, X, LDA, RCOND,
429 $ RWORK, RWORK( NRHS+1 ), WORK,
430 $ RWORK( 2*NRHS+1 ), INFO )
431 *
432 * Check the error code from ZPOSVX.
433 *
434 IF( INFO.NE.IZERO )
435 $ CALL ALAERH( PATH, 'ZPOSVX', INFO, IZERO,
436 $ FACT // UPLO, N, N, -1, -1, NRHS,
437 $ IMAT, NFAIL, NERRS, NOUT )
438 GO TO 90
439 *
440 IF( INFO.EQ.0 ) THEN
441 IF( .NOT.PREFAC ) THEN
442 *
443 * Reconstruct matrix from factors and compute
444 * residual.
445 *
446 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA,
447 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
448 K1 = 1
449 ELSE
450 K1 = 2
451 END IF
452 *
453 * Compute residual of the computed solution.
454 *
455 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
456 $ LDA )
457 CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
458 $ WORK, LDA, RWORK( 2*NRHS+1 ),
459 $ RESULT( 2 ) )
460 *
461 * Check solution from generated exact solution.
462 *
463 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
464 $ 'N' ) ) ) THEN
465 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
466 $ RCONDC, RESULT( 3 ) )
467 ELSE
468 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
469 $ ROLDC, RESULT( 3 ) )
470 END IF
471 *
472 * Check the error bounds from iterative
473 * refinement.
474 *
475 CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
476 $ X, LDA, XACT, LDA, RWORK,
477 $ RWORK( NRHS+1 ), RESULT( 4 ) )
478 ELSE
479 K1 = 6
480 END IF
481 *
482 * Compare RCOND from ZPOSVX 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 80 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 IF( PREFAC ) THEN
495 WRITE( NOUT, FMT = 9997 )'ZPOSVX', FACT,
496 $ UPLO, N, EQUED, IMAT, K, RESULT( K )
497 ELSE
498 WRITE( NOUT, FMT = 9998 )'ZPOSVX', FACT,
499 $ UPLO, N, IMAT, K, RESULT( K )
500 END IF
501 NFAIL = NFAIL + 1
502 END IF
503 80 CONTINUE
504 NRUN = NRUN + 7 - K1
505 *
506 * --- Test ZPOSVXX ---
507 *
508 * Restore the matrices A and B.
509 *
510 CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
511 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
512
513 IF( .NOT.PREFAC )
514 $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ),
515 $ CMPLX( ZERO ), AFAC, LDA )
516 CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ),
517 $ CMPLX( ZERO ), X, LDA )
518 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
519 *
520 * Equilibrate the matrix if FACT='F' and
521 * EQUED='Y'.
522 *
523 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
524 $ EQUED )
525 END IF
526 *
527 * Solve the system and compute the condition number
528 * and error bounds using ZPOSVXX.
529 *
530 SRNAMT = 'ZPOSVXX'
531 N_ERR_BNDS = 3
532 CALL ZPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
533 $ LDA, EQUED, S, B, LDA, X,
534 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
535 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
536 $ RWORK( 2*NRHS+1 ), INFO )
537 *
538 * Check the error code from ZPOSVXX.
539 *
540 IF( INFO.EQ.N+1 ) GOTO 90
541 IF( INFO.NE.IZERO ) THEN
542 CALL ALAERH( PATH, 'ZPOSVXX', INFO, IZERO,
543 $ FACT // UPLO, N, N, -1, -1, NRHS,
544 $ IMAT, NFAIL, NERRS, NOUT )
545 GO TO 90
546 END IF
547 *
548 IF( INFO.EQ.0 ) THEN
549 IF( .NOT.PREFAC ) THEN
550 *
551 * Reconstruct matrix from factors and compute
552 * residual.
553 *
554 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA,
555 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
556 K1 = 1
557 ELSE
558 K1 = 2
559 END IF
560 *
561 * Compute residual of the computed solution.
562 *
563 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
564 $ LDA )
565 CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
566 $ WORK, LDA, RWORK( 2*NRHS+1 ),
567 $ RESULT( 2 ) )
568 *
569 * Check solution from generated exact solution.
570 *
571 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
572 $ 'N' ) ) ) THEN
573 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
574 $ RCONDC, RESULT( 3 ) )
575 ELSE
576 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
577 $ ROLDC, RESULT( 3 ) )
578 END IF
579 *
580 * Check the error bounds from iterative
581 * refinement.
582 *
583 CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
584 $ X, LDA, XACT, LDA, RWORK,
585 $ RWORK( NRHS+1 ), RESULT( 4 ) )
586 ELSE
587 K1 = 6
588 END IF
589 *
590 * Compare RCOND from ZPOSVXX with the computed value
591 * in RCONDC.
592 *
593 RESULT( 6 ) = DGET06( RCOND, RCONDC )
594 *
595 * Print information about the tests that did not pass
596 * the threshold.
597 *
598 DO 85 K = K1, 6
599 IF( RESULT( K ).GE.THRESH ) THEN
600 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
601 $ CALL ALADHD( NOUT, PATH )
602 IF( PREFAC ) THEN
603 WRITE( NOUT, FMT = 9997 )'ZPOSVXX', FACT,
604 $ UPLO, N, EQUED, IMAT, K, RESULT( K )
605 ELSE
606 WRITE( NOUT, FMT = 9998 )'ZPOSVXX', FACT,
607 $ UPLO, N, IMAT, K, RESULT( K )
608 END IF
609 NFAIL = NFAIL + 1
610 END IF
611 85 CONTINUE
612 NRUN = NRUN + 7 - K1
613 90 CONTINUE
614 100 CONTINUE
615 110 CONTINUE
616 120 CONTINUE
617 130 CONTINUE
618 *
619 * Print a summary of the results.
620 *
621 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
622 *
623
624 * Test Error Bounds for ZGESVXX
625
626 CALL ZEBCHVXX(THRESH, PATH)
627
628 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1,
629 $ ', test(', I1, ')=', G12.5 )
630 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
631 $ ', type ', I1, ', test(', I1, ')=', G12.5 )
632 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
633 $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =',
634 $ G12.5 )
635 RETURN
636 *
637 * End of ZDRVPO
638 *
639 END
2 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ RWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * April 2009
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 NVAL( * )
17 DOUBLE PRECISION RWORK( * ), S( * )
18 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
19 $ BSAV( * ), WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZDRVPO tests the driver routines ZPOSV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise zdrvpo.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) DOUBLE PRECISION
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * NMAX (input) INTEGER
57 * The maximum value permitted for N, used in dimensioning the
58 * work arrays.
59 *
60 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
61 *
62 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
63 *
64 * ASAV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
65 *
66 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
67 *
68 * BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
69 *
70 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
71 *
72 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
73 *
74 * S (workspace) DOUBLE PRECISION array, dimension (NMAX)
75 *
76 * WORK (workspace) COMPLEX*16 array, dimension
77 * (NMAX*max(3,NRHS))
78 *
79 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
80 *
81 * NOUT (input) INTEGER
82 * The unit number for output.
83 *
84 * =====================================================================
85 *
86 * .. Parameters ..
87 DOUBLE PRECISION ONE, ZERO
88 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
89 INTEGER NTYPES
90 PARAMETER ( NTYPES = 9 )
91 INTEGER NTESTS
92 PARAMETER ( NTESTS = 6 )
93 * ..
94 * .. Local Scalars ..
95 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
96 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
97 CHARACTER*3 PATH
98 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
99 $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN,
100 $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
101 $ N_ERR_BNDS
102 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
103 $ ROLDC, SCOND, RPVGRW_SVXX
104 * ..
105 * .. Local Arrays ..
106 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
107 INTEGER ISEED( 4 ), ISEEDY( 4 )
108 DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ),
109 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
110 * ..
111 * .. External Functions ..
112 LOGICAL LSAME
113 DOUBLE PRECISION DGET06, ZLANHE
114 EXTERNAL LSAME, DGET06, ZLANHE
115 * ..
116 * .. External Subroutines ..
117 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
118 $ ZLACPY, ZLAIPD, ZLAQHE, ZLARHS, ZLASET, ZLATB4,
119 $ ZLATMS, ZPOEQU, ZPOSV, ZPOSVX, ZPOT01, ZPOT02,
120 $ ZPOT05, ZPOTRF, ZPOTRI, ZPOSVXX
121 * ..
122 * .. Scalars in Common ..
123 LOGICAL LERR, OK
124 CHARACTER*32 SRNAMT
125 INTEGER INFOT, NUNIT
126 * ..
127 * .. Common blocks ..
128 COMMON / INFOC / INFOT, NUNIT, OK, LERR
129 COMMON / SRNAMC / SRNAMT
130 * ..
131 * .. Intrinsic Functions ..
132 INTRINSIC DCMPLX, MAX
133 * ..
134 * .. Data statements ..
135 DATA ISEEDY / 1988, 1989, 1990, 1991 /
136 DATA UPLOS / 'U', 'L' /
137 DATA FACTS / 'F', 'N', 'E' /
138 DATA EQUEDS / 'N', 'Y' /
139 * ..
140 * .. Executable Statements ..
141 *
142 * Initialize constants and the random number seed.
143 *
144 PATH( 1: 1 ) = 'Zomplex precision'
145 PATH( 2: 3 ) = 'PO'
146 NRUN = 0
147 NFAIL = 0
148 NERRS = 0
149 DO 10 I = 1, 4
150 ISEED( I ) = ISEEDY( I )
151 10 CONTINUE
152 *
153 * Test the error exits
154 *
155 IF( TSTERR )
156 $ CALL ZERRVX( PATH, NOUT )
157 INFOT = 0
158 *
159 * Set the block size and minimum block size for testing.
160 *
161 NB = 1
162 NBMIN = 2
163 CALL XLAENV( 1, NB )
164 CALL XLAENV( 2, NBMIN )
165 *
166 * Do for each value of N in NVAL
167 *
168 DO 130 IN = 1, NN
169 N = NVAL( IN )
170 LDA = MAX( N, 1 )
171 XTYPE = 'N'
172 NIMAT = NTYPES
173 IF( N.LE.0 )
174 $ NIMAT = 1
175 *
176 DO 120 IMAT = 1, NIMAT
177 *
178 * Do the tests only if DOTYPE( IMAT ) is true.
179 *
180 IF( .NOT.DOTYPE( IMAT ) )
181 $ GO TO 120
182 *
183 * Skip types 3, 4, or 5 if the matrix size is too small.
184 *
185 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
186 IF( ZEROT .AND. N.LT.IMAT-2 )
187 $ GO TO 120
188 *
189 * Do first for UPLO = 'U', then for UPLO = 'L'
190 *
191 DO 110 IUPLO = 1, 2
192 UPLO = UPLOS( IUPLO )
193 *
194 * Set up parameters with ZLATB4 and generate a test matrix
195 * with ZLATMS.
196 *
197 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
198 $ CNDNUM, DIST )
199 *
200 SRNAMT = 'ZLATMS'
201 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
202 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
203 $ INFO )
204 *
205 * Check error code from ZLATMS.
206 *
207 IF( INFO.NE.0 ) THEN
208 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
209 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
210 GO TO 110
211 END IF
212 *
213 * For types 3-5, zero one row and column of the matrix to
214 * test that INFO is returned correctly.
215 *
216 IF( ZEROT ) THEN
217 IF( IMAT.EQ.3 ) THEN
218 IZERO = 1
219 ELSE IF( IMAT.EQ.4 ) THEN
220 IZERO = N
221 ELSE
222 IZERO = N / 2 + 1
223 END IF
224 IOFF = ( IZERO-1 )*LDA
225 *
226 * Set row and column IZERO of A to 0.
227 *
228 IF( IUPLO.EQ.1 ) THEN
229 DO 20 I = 1, IZERO - 1
230 A( IOFF+I ) = ZERO
231 20 CONTINUE
232 IOFF = IOFF + IZERO
233 DO 30 I = IZERO, N
234 A( IOFF ) = ZERO
235 IOFF = IOFF + LDA
236 30 CONTINUE
237 ELSE
238 IOFF = IZERO
239 DO 40 I = 1, IZERO - 1
240 A( IOFF ) = ZERO
241 IOFF = IOFF + LDA
242 40 CONTINUE
243 IOFF = IOFF - IZERO
244 DO 50 I = IZERO, N
245 A( IOFF+I ) = ZERO
246 50 CONTINUE
247 END IF
248 ELSE
249 IZERO = 0
250 END IF
251 *
252 * Set the imaginary part of the diagonals.
253 *
254 CALL ZLAIPD( N, A, LDA+1, 0 )
255 *
256 * Save a copy of the matrix A in ASAV.
257 *
258 CALL ZLACPY( UPLO, N, N, A, LDA, ASAV, LDA )
259 *
260 DO 100 IEQUED = 1, 2
261 EQUED = EQUEDS( IEQUED )
262 IF( IEQUED.EQ.1 ) THEN
263 NFACT = 3
264 ELSE
265 NFACT = 1
266 END IF
267 *
268 DO 90 IFACT = 1, NFACT
269 FACT = FACTS( IFACT )
270 PREFAC = LSAME( FACT, 'F' )
271 NOFACT = LSAME( FACT, 'N' )
272 EQUIL = LSAME( FACT, 'E' )
273 *
274 IF( ZEROT ) THEN
275 IF( PREFAC )
276 $ GO TO 90
277 RCONDC = ZERO
278 *
279 ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN
280 *
281 * Compute the condition number for comparison with
282 * the value returned by ZPOSVX (FACT = 'N' reuses
283 * the condition number from the previous iteration
284 * with FACT = 'F').
285 *
286 CALL ZLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA )
287 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
288 *
289 * Compute row and column scale factors to
290 * equilibrate the matrix A.
291 *
292 CALL ZPOEQU( N, AFAC, LDA, S, SCOND, AMAX,
293 $ INFO )
294 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
295 IF( IEQUED.GT.1 )
296 $ SCOND = ZERO
297 *
298 * Equilibrate the matrix.
299 *
300 CALL ZLAQHE( UPLO, N, AFAC, LDA, S, SCOND,
301 $ AMAX, EQUED )
302 END IF
303 END IF
304 *
305 * Save the condition number of the
306 * non-equilibrated system for use in ZGET04.
307 *
308 IF( EQUIL )
309 $ ROLDC = RCONDC
310 *
311 * Compute the 1-norm of A.
312 *
313 ANORM = ZLANHE( '1', UPLO, N, AFAC, LDA, RWORK )
314 *
315 * Factor the matrix A.
316 *
317 CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO )
318 *
319 * Form the inverse of A.
320 *
321 CALL ZLACPY( UPLO, N, N, AFAC, LDA, A, LDA )
322 CALL ZPOTRI( UPLO, N, A, LDA, INFO )
323 *
324 * Compute the 1-norm condition number of A.
325 *
326 AINVNM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
327 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
328 RCONDC = ONE
329 ELSE
330 RCONDC = ( ONE / ANORM ) / AINVNM
331 END IF
332 END IF
333 *
334 * Restore the matrix A.
335 *
336 CALL ZLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
337 *
338 * Form an exact solution and set the right hand side.
339 *
340 SRNAMT = 'ZLARHS'
341 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
342 $ NRHS, A, LDA, XACT, LDA, B, LDA,
343 $ ISEED, INFO )
344 XTYPE = 'C'
345 CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
346 *
347 IF( NOFACT ) THEN
348 *
349 * --- Test ZPOSV ---
350 *
351 * Compute the L*L' or U'*U factorization of the
352 * matrix and solve the system.
353 *
354 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
355 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
356 *
357 SRNAMT = 'ZPOSV '
358 CALL ZPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA,
359 $ INFO )
360 *
361 * Check error code from ZPOSV .
362 *
363 IF( INFO.NE.IZERO ) THEN
364 CALL ALAERH( PATH, 'ZPOSV ', INFO, IZERO,
365 $ UPLO, N, N, -1, -1, NRHS, IMAT,
366 $ NFAIL, NERRS, NOUT )
367 GO TO 70
368 ELSE IF( INFO.NE.0 ) THEN
369 GO TO 70
370 END IF
371 *
372 * Reconstruct matrix from factors and compute
373 * residual.
374 *
375 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK,
376 $ RESULT( 1 ) )
377 *
378 * Compute residual of the computed solution.
379 *
380 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
381 $ LDA )
382 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
383 $ WORK, LDA, RWORK, RESULT( 2 ) )
384 *
385 * Check solution from generated exact solution.
386 *
387 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
388 $ RESULT( 3 ) )
389 NT = 3
390 *
391 * Print information about the tests that did not
392 * pass the threshold.
393 *
394 DO 60 K = 1, NT
395 IF( RESULT( K ).GE.THRESH ) THEN
396 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
397 $ CALL ALADHD( NOUT, PATH )
398 WRITE( NOUT, FMT = 9999 )'ZPOSV ', UPLO,
399 $ N, IMAT, K, RESULT( K )
400 NFAIL = NFAIL + 1
401 END IF
402 60 CONTINUE
403 NRUN = NRUN + NT
404 70 CONTINUE
405 END IF
406 *
407 * --- Test ZPOSVX ---
408 *
409 IF( .NOT.PREFAC )
410 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
411 $ DCMPLX( ZERO ), AFAC, LDA )
412 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
413 $ DCMPLX( ZERO ), X, LDA )
414 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
415 *
416 * Equilibrate the matrix if FACT='F' and
417 * EQUED='Y'.
418 *
419 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
420 $ EQUED )
421 END IF
422 *
423 * Solve the system and compute the condition number
424 * and error bounds using ZPOSVX.
425 *
426 SRNAMT = 'ZPOSVX'
427 CALL ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
428 $ LDA, EQUED, S, B, LDA, X, LDA, RCOND,
429 $ RWORK, RWORK( NRHS+1 ), WORK,
430 $ RWORK( 2*NRHS+1 ), INFO )
431 *
432 * Check the error code from ZPOSVX.
433 *
434 IF( INFO.NE.IZERO )
435 $ CALL ALAERH( PATH, 'ZPOSVX', INFO, IZERO,
436 $ FACT // UPLO, N, N, -1, -1, NRHS,
437 $ IMAT, NFAIL, NERRS, NOUT )
438 GO TO 90
439 *
440 IF( INFO.EQ.0 ) THEN
441 IF( .NOT.PREFAC ) THEN
442 *
443 * Reconstruct matrix from factors and compute
444 * residual.
445 *
446 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA,
447 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
448 K1 = 1
449 ELSE
450 K1 = 2
451 END IF
452 *
453 * Compute residual of the computed solution.
454 *
455 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
456 $ LDA )
457 CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
458 $ WORK, LDA, RWORK( 2*NRHS+1 ),
459 $ RESULT( 2 ) )
460 *
461 * Check solution from generated exact solution.
462 *
463 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
464 $ 'N' ) ) ) THEN
465 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
466 $ RCONDC, RESULT( 3 ) )
467 ELSE
468 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
469 $ ROLDC, RESULT( 3 ) )
470 END IF
471 *
472 * Check the error bounds from iterative
473 * refinement.
474 *
475 CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
476 $ X, LDA, XACT, LDA, RWORK,
477 $ RWORK( NRHS+1 ), RESULT( 4 ) )
478 ELSE
479 K1 = 6
480 END IF
481 *
482 * Compare RCOND from ZPOSVX 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 80 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 IF( PREFAC ) THEN
495 WRITE( NOUT, FMT = 9997 )'ZPOSVX', FACT,
496 $ UPLO, N, EQUED, IMAT, K, RESULT( K )
497 ELSE
498 WRITE( NOUT, FMT = 9998 )'ZPOSVX', FACT,
499 $ UPLO, N, IMAT, K, RESULT( K )
500 END IF
501 NFAIL = NFAIL + 1
502 END IF
503 80 CONTINUE
504 NRUN = NRUN + 7 - K1
505 *
506 * --- Test ZPOSVXX ---
507 *
508 * Restore the matrices A and B.
509 *
510 CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
511 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
512
513 IF( .NOT.PREFAC )
514 $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ),
515 $ CMPLX( ZERO ), AFAC, LDA )
516 CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ),
517 $ CMPLX( ZERO ), X, LDA )
518 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
519 *
520 * Equilibrate the matrix if FACT='F' and
521 * EQUED='Y'.
522 *
523 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
524 $ EQUED )
525 END IF
526 *
527 * Solve the system and compute the condition number
528 * and error bounds using ZPOSVXX.
529 *
530 SRNAMT = 'ZPOSVXX'
531 N_ERR_BNDS = 3
532 CALL ZPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
533 $ LDA, EQUED, S, B, LDA, X,
534 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
535 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
536 $ RWORK( 2*NRHS+1 ), INFO )
537 *
538 * Check the error code from ZPOSVXX.
539 *
540 IF( INFO.EQ.N+1 ) GOTO 90
541 IF( INFO.NE.IZERO ) THEN
542 CALL ALAERH( PATH, 'ZPOSVXX', INFO, IZERO,
543 $ FACT // UPLO, N, N, -1, -1, NRHS,
544 $ IMAT, NFAIL, NERRS, NOUT )
545 GO TO 90
546 END IF
547 *
548 IF( INFO.EQ.0 ) THEN
549 IF( .NOT.PREFAC ) THEN
550 *
551 * Reconstruct matrix from factors and compute
552 * residual.
553 *
554 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA,
555 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
556 K1 = 1
557 ELSE
558 K1 = 2
559 END IF
560 *
561 * Compute residual of the computed solution.
562 *
563 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
564 $ LDA )
565 CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
566 $ WORK, LDA, RWORK( 2*NRHS+1 ),
567 $ RESULT( 2 ) )
568 *
569 * Check solution from generated exact solution.
570 *
571 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
572 $ 'N' ) ) ) THEN
573 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
574 $ RCONDC, RESULT( 3 ) )
575 ELSE
576 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
577 $ ROLDC, RESULT( 3 ) )
578 END IF
579 *
580 * Check the error bounds from iterative
581 * refinement.
582 *
583 CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
584 $ X, LDA, XACT, LDA, RWORK,
585 $ RWORK( NRHS+1 ), RESULT( 4 ) )
586 ELSE
587 K1 = 6
588 END IF
589 *
590 * Compare RCOND from ZPOSVXX with the computed value
591 * in RCONDC.
592 *
593 RESULT( 6 ) = DGET06( RCOND, RCONDC )
594 *
595 * Print information about the tests that did not pass
596 * the threshold.
597 *
598 DO 85 K = K1, 6
599 IF( RESULT( K ).GE.THRESH ) THEN
600 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
601 $ CALL ALADHD( NOUT, PATH )
602 IF( PREFAC ) THEN
603 WRITE( NOUT, FMT = 9997 )'ZPOSVXX', FACT,
604 $ UPLO, N, EQUED, IMAT, K, RESULT( K )
605 ELSE
606 WRITE( NOUT, FMT = 9998 )'ZPOSVXX', FACT,
607 $ UPLO, N, IMAT, K, RESULT( K )
608 END IF
609 NFAIL = NFAIL + 1
610 END IF
611 85 CONTINUE
612 NRUN = NRUN + 7 - K1
613 90 CONTINUE
614 100 CONTINUE
615 110 CONTINUE
616 120 CONTINUE
617 130 CONTINUE
618 *
619 * Print a summary of the results.
620 *
621 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
622 *
623
624 * Test Error Bounds for ZGESVXX
625
626 CALL ZEBCHVXX(THRESH, PATH)
627
628 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1,
629 $ ', test(', I1, ')=', G12.5 )
630 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
631 $ ', type ', I1, ', test(', I1, ')=', G12.5 )
632 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5,
633 $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =',
634 $ G12.5 )
635 RETURN
636 *
637 * End of ZDRVPO
638 *
639 END