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