LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
zdrvpox.f
Go to the documentation of this file.
1 *> \brief \b ZDRVPOX
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
12 * A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
13 * RWORK, NOUT )
14 *
15 * .. Scalar Arguments ..
16 * LOGICAL TSTERR
17 * INTEGER NMAX, NN, NOUT, NRHS
18 * DOUBLE PRECISION THRESH
19 * ..
20 * .. Array Arguments ..
21 * LOGICAL DOTYPE( * )
22 * INTEGER NVAL( * )
23 * DOUBLE PRECISION RWORK( * ), S( * )
24 * COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
25 * $ BSAV( * ), WORK( * ), X( * ), XACT( * )
26 * ..
27 *
28 *
29 *> \par Purpose:
30 * =============
31 *>
32 *> \verbatim
33 *>
34 *> ZDRVPO tests the driver routines ZPOSV, -SVX, and -SVXX.
35 *>
36 *> Note that this file is used only when the XBLAS are available,
37 *> otherwise zdrvpo.f defines this subroutine.
38 *> \endverbatim
39 *
40 * Arguments:
41 * ==========
42 *
43 *> \param[in] DOTYPE
44 *> \verbatim
45 *> DOTYPE is LOGICAL array, dimension (NTYPES)
46 *> The matrix types to be used for testing. Matrices of type j
47 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
48 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
49 *> \endverbatim
50 *>
51 *> \param[in] NN
52 *> \verbatim
53 *> NN is INTEGER
54 *> The number of values of N contained in the vector NVAL.
55 *> \endverbatim
56 *>
57 *> \param[in] NVAL
58 *> \verbatim
59 *> NVAL is INTEGER array, dimension (NN)
60 *> The values of the matrix dimension N.
61 *> \endverbatim
62 *>
63 *> \param[in] NRHS
64 *> \verbatim
65 *> NRHS is INTEGER
66 *> The number of right hand side vectors to be generated for
67 *> each linear system.
68 *> \endverbatim
69 *>
70 *> \param[in] THRESH
71 *> \verbatim
72 *> THRESH is DOUBLE PRECISION
73 *> The threshold value for the test ratios. A result is
74 *> included in the output file if RESULT >= THRESH. To have
75 *> every test ratio printed, use THRESH = 0.
76 *> \endverbatim
77 *>
78 *> \param[in] TSTERR
79 *> \verbatim
80 *> TSTERR is LOGICAL
81 *> Flag that indicates whether error exits are to be tested.
82 *> \endverbatim
83 *>
84 *> \param[in] NMAX
85 *> \verbatim
86 *> NMAX is INTEGER
87 *> The maximum value permitted for N, used in dimensioning the
88 *> work arrays.
89 *> \endverbatim
90 *>
91 *> \param[out] A
92 *> \verbatim
93 *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
94 *> \endverbatim
95 *>
96 *> \param[out] AFAC
97 *> \verbatim
98 *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
99 *> \endverbatim
100 *>
101 *> \param[out] ASAV
102 *> \verbatim
103 *> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX)
104 *> \endverbatim
105 *>
106 *> \param[out] B
107 *> \verbatim
108 *> B is COMPLEX*16 array, dimension (NMAX*NRHS)
109 *> \endverbatim
110 *>
111 *> \param[out] BSAV
112 *> \verbatim
113 *> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS)
114 *> \endverbatim
115 *>
116 *> \param[out] X
117 *> \verbatim
118 *> X is COMPLEX*16 array, dimension (NMAX*NRHS)
119 *> \endverbatim
120 *>
121 *> \param[out] XACT
122 *> \verbatim
123 *> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
124 *> \endverbatim
125 *>
126 *> \param[out] S
127 *> \verbatim
128 *> S is DOUBLE PRECISION array, dimension (NMAX)
129 *> \endverbatim
130 *>
131 *> \param[out] WORK
132 *> \verbatim
133 *> WORK is COMPLEX*16 array, dimension
134 *> (NMAX*max(3,NRHS))
135 *> \endverbatim
136 *>
137 *> \param[out] RWORK
138 *> \verbatim
139 *> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
140 *> \endverbatim
141 *>
142 *> \param[in] NOUT
143 *> \verbatim
144 *> NOUT is INTEGER
145 *> The unit number for output.
146 *> \endverbatim
147 *
148 * Authors:
149 * ========
150 *
151 *> \author Univ. of Tennessee
152 *> \author Univ. of California Berkeley
153 *> \author Univ. of Colorado Denver
154 *> \author NAG Ltd.
155 *
156 *> \date November 2013
157 *
158 *> \ingroup complex16_lin
159 *
160 * =====================================================================
161  SUBROUTINE zdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
162  $ a, afac, asav, b, bsav, x, xact, s, work,
163  $ rwork, nout )
164 *
165 * -- LAPACK test routine (version 3.5.0) --
166 * -- LAPACK is a software package provided by Univ. of Tennessee, --
167 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
168 * November 2013
169 *
170 * .. Scalar Arguments ..
171  LOGICAL tsterr
172  INTEGER nmax, nn, nout, nrhs
173  DOUBLE PRECISION thresh
174 * ..
175 * .. Array Arguments ..
176  LOGICAL dotype( * )
177  INTEGER nval( * )
178  DOUBLE PRECISION rwork( * ), s( * )
179  COMPLEX*16 a( * ), afac( * ), asav( * ), b( * ),
180  $ bsav( * ), work( * ), x( * ), xact( * )
181 * ..
182 *
183 * =====================================================================
184 *
185 * .. Parameters ..
186  DOUBLE PRECISION one, zero
187  parameter ( one = 1.0d+0, zero = 0.0d+0 )
188  INTEGER ntypes
189  parameter ( ntypes = 9 )
190  INTEGER ntests
191  parameter ( ntests = 6 )
192 * ..
193 * .. Local Scalars ..
194  LOGICAL equil, nofact, prefac, zerot
195  CHARACTER dist, equed, fact, TYPE, uplo, xtype
196  CHARACTER*3 path
197  INTEGER i, iequed, ifact, imat, in, info, ioff, iuplo,
198  $ izero, k, k1, kl, ku, lda, mode, n, nb, nbmin,
199  $ nerrs, nfact, nfail, nimat, nrun, nt,
200  $ n_err_bnds
201  DOUBLE PRECISION ainvnm, amax, anorm, cndnum, rcond, rcondc,
202  $ roldc, scond, rpvgrw_svxx
203 * ..
204 * .. Local Arrays ..
205  CHARACTER equeds( 2 ), facts( 3 ), uplos( 2 )
206  INTEGER iseed( 4 ), iseedy( 4 )
207  DOUBLE PRECISION result( ntests ), berr( nrhs ),
208  $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
209 * ..
210 * .. External Functions ..
211  LOGICAL lsame
212  DOUBLE PRECISION dget06, zlanhe
213  EXTERNAL lsame, dget06, zlanhe
214 * ..
215 * .. External Subroutines ..
216  EXTERNAL aladhd, alaerh, alasvm, xlaenv, zerrvx, zget04,
220 * ..
221 * .. Scalars in Common ..
222  LOGICAL lerr, ok
223  CHARACTER*32 srnamt
224  INTEGER infot, nunit
225 * ..
226 * .. Common blocks ..
227  COMMON / infoc / infot, nunit, ok, lerr
228  COMMON / srnamc / srnamt
229 * ..
230 * .. Intrinsic Functions ..
231  INTRINSIC dcmplx, max
232 * ..
233 * .. Data statements ..
234  DATA iseedy / 1988, 1989, 1990, 1991 /
235  DATA uplos / 'U', 'L' /
236  DATA facts / 'F', 'N', 'E' /
237  DATA equeds / 'N', 'Y' /
238 * ..
239 * .. Executable Statements ..
240 *
241 * Initialize constants and the random number seed.
242 *
243  path( 1: 1 ) = 'Zomplex precision'
244  path( 2: 3 ) = 'PO'
245  nrun = 0
246  nfail = 0
247  nerrs = 0
248  DO 10 i = 1, 4
249  iseed( i ) = iseedy( i )
250  10 CONTINUE
251 *
252 * Test the error exits
253 *
254  IF( tsterr )
255  $ CALL zerrvx( path, nout )
256  infot = 0
257 *
258 * Set the block size and minimum block size for testing.
259 *
260  nb = 1
261  nbmin = 2
262  CALL xlaenv( 1, nb )
263  CALL xlaenv( 2, nbmin )
264 *
265 * Do for each value of N in NVAL
266 *
267  DO 130 in = 1, nn
268  n = nval( in )
269  lda = max( n, 1 )
270  xtype = 'N'
271  nimat = ntypes
272  IF( n.LE.0 )
273  $ nimat = 1
274 *
275  DO 120 imat = 1, nimat
276 *
277 * Do the tests only if DOTYPE( IMAT ) is true.
278 *
279  IF( .NOT.dotype( imat ) )
280  $ GO TO 120
281 *
282 * Skip types 3, 4, or 5 if the matrix size is too small.
283 *
284  zerot = imat.GE.3 .AND. imat.LE.5
285  IF( zerot .AND. n.LT.imat-2 )
286  $ GO TO 120
287 *
288 * Do first for UPLO = 'U', then for UPLO = 'L'
289 *
290  DO 110 iuplo = 1, 2
291  uplo = uplos( iuplo )
292 *
293 * Set up parameters with ZLATB4 and generate a test matrix
294 * with ZLATMS.
295 *
296  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
297  $ cndnum, dist )
298 *
299  srnamt = 'ZLATMS'
300  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
301  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
302  $ info )
303 *
304 * Check error code from ZLATMS.
305 *
306  IF( info.NE.0 ) THEN
307  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n, -1,
308  $ -1, -1, imat, nfail, nerrs, nout )
309  GO TO 110
310  END IF
311 *
312 * For types 3-5, zero one row and column of the matrix to
313 * test that INFO is returned correctly.
314 *
315  IF( zerot ) THEN
316  IF( imat.EQ.3 ) THEN
317  izero = 1
318  ELSE IF( imat.EQ.4 ) THEN
319  izero = n
320  ELSE
321  izero = n / 2 + 1
322  END IF
323  ioff = ( izero-1 )*lda
324 *
325 * Set row and column IZERO of A to 0.
326 *
327  IF( iuplo.EQ.1 ) THEN
328  DO 20 i = 1, izero - 1
329  a( ioff+i ) = zero
330  20 CONTINUE
331  ioff = ioff + izero
332  DO 30 i = izero, n
333  a( ioff ) = zero
334  ioff = ioff + lda
335  30 CONTINUE
336  ELSE
337  ioff = izero
338  DO 40 i = 1, izero - 1
339  a( ioff ) = zero
340  ioff = ioff + lda
341  40 CONTINUE
342  ioff = ioff - izero
343  DO 50 i = izero, n
344  a( ioff+i ) = zero
345  50 CONTINUE
346  END IF
347  ELSE
348  izero = 0
349  END IF
350 *
351 * Set the imaginary part of the diagonals.
352 *
353  CALL zlaipd( n, a, lda+1, 0 )
354 *
355 * Save a copy of the matrix A in ASAV.
356 *
357  CALL zlacpy( uplo, n, n, a, lda, asav, lda )
358 *
359  DO 100 iequed = 1, 2
360  equed = equeds( iequed )
361  IF( iequed.EQ.1 ) THEN
362  nfact = 3
363  ELSE
364  nfact = 1
365  END IF
366 *
367  DO 90 ifact = 1, nfact
368  fact = facts( ifact )
369  prefac = lsame( fact, 'F' )
370  nofact = lsame( fact, 'N' )
371  equil = lsame( fact, 'E' )
372 *
373  IF( zerot ) THEN
374  IF( prefac )
375  $ GO TO 90
376  rcondc = zero
377 *
378  ELSE IF( .NOT.lsame( fact, 'N' ) ) THEN
379 *
380 * Compute the condition number for comparison with
381 * the value returned by ZPOSVX (FACT = 'N' reuses
382 * the condition number from the previous iteration
383 * with FACT = 'F').
384 *
385  CALL zlacpy( uplo, n, n, asav, lda, afac, lda )
386  IF( equil .OR. iequed.GT.1 ) THEN
387 *
388 * Compute row and column scale factors to
389 * equilibrate the matrix A.
390 *
391  CALL zpoequ( n, afac, lda, s, scond, amax,
392  $ info )
393  IF( info.EQ.0 .AND. n.GT.0 ) THEN
394  IF( iequed.GT.1 )
395  $ scond = zero
396 *
397 * Equilibrate the matrix.
398 *
399  CALL zlaqhe( uplo, n, afac, lda, s, scond,
400  $ amax, equed )
401  END IF
402  END IF
403 *
404 * Save the condition number of the
405 * non-equilibrated system for use in ZGET04.
406 *
407  IF( equil )
408  $ roldc = rcondc
409 *
410 * Compute the 1-norm of A.
411 *
412  anorm = zlanhe( '1', uplo, n, afac, lda, rwork )
413 *
414 * Factor the matrix A.
415 *
416  CALL zpotrf( uplo, n, afac, lda, info )
417 *
418 * Form the inverse of A.
419 *
420  CALL zlacpy( uplo, n, n, afac, lda, a, lda )
421  CALL zpotri( uplo, n, a, lda, info )
422 *
423 * Compute the 1-norm condition number of A.
424 *
425  ainvnm = zlanhe( '1', uplo, n, a, lda, rwork )
426  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
427  rcondc = one
428  ELSE
429  rcondc = ( one / anorm ) / ainvnm
430  END IF
431  END IF
432 *
433 * Restore the matrix A.
434 *
435  CALL zlacpy( uplo, n, n, asav, lda, a, lda )
436 *
437 * Form an exact solution and set the right hand side.
438 *
439  srnamt = 'ZLARHS'
440  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
441  $ nrhs, a, lda, xact, lda, b, lda,
442  $ iseed, info )
443  xtype = 'C'
444  CALL zlacpy( 'Full', n, nrhs, b, lda, bsav, lda )
445 *
446  IF( nofact ) THEN
447 *
448 * --- Test ZPOSV ---
449 *
450 * Compute the L*L' or U'*U factorization of the
451 * matrix and solve the system.
452 *
453  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
454  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
455 *
456  srnamt = 'ZPOSV '
457  CALL zposv( uplo, n, nrhs, afac, lda, x, lda,
458  $ info )
459 *
460 * Check error code from ZPOSV .
461 *
462  IF( info.NE.izero ) THEN
463  CALL alaerh( path, 'ZPOSV ', info, izero,
464  $ uplo, n, n, -1, -1, nrhs, imat,
465  $ nfail, nerrs, nout )
466  GO TO 70
467  ELSE IF( info.NE.0 ) THEN
468  GO TO 70
469  END IF
470 *
471 * Reconstruct matrix from factors and compute
472 * residual.
473 *
474  CALL zpot01( uplo, n, a, lda, afac, lda, rwork,
475  $ result( 1 ) )
476 *
477 * Compute residual of the computed solution.
478 *
479  CALL zlacpy( 'Full', n, nrhs, b, lda, work,
480  $ lda )
481  CALL zpot02( uplo, n, nrhs, a, lda, x, lda,
482  $ work, lda, rwork, result( 2 ) )
483 *
484 * Check solution from generated exact solution.
485 *
486  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
487  $ result( 3 ) )
488  nt = 3
489 *
490 * Print information about the tests that did not
491 * pass the threshold.
492 *
493  DO 60 k = 1, nt
494  IF( result( k ).GE.thresh ) THEN
495  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
496  $ CALL aladhd( nout, path )
497  WRITE( nout, fmt = 9999 )'ZPOSV ', uplo,
498  $ n, imat, k, result( k )
499  nfail = nfail + 1
500  END IF
501  60 CONTINUE
502  nrun = nrun + nt
503  70 CONTINUE
504  END IF
505 *
506 * --- Test ZPOSVX ---
507 *
508  IF( .NOT.prefac )
509  $ CALL zlaset( uplo, n, n, dcmplx( zero ),
510  $ dcmplx( zero ), afac, lda )
511  CALL zlaset( 'Full', n, nrhs, dcmplx( zero ),
512  $ dcmplx( zero ), x, lda )
513  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
514 *
515 * Equilibrate the matrix if FACT='F' and
516 * EQUED='Y'.
517 *
518  CALL zlaqhe( uplo, n, a, lda, s, scond, amax,
519  $ equed )
520  END IF
521 *
522 * Solve the system and compute the condition number
523 * and error bounds using ZPOSVX.
524 *
525  srnamt = 'ZPOSVX'
526  CALL zposvx( fact, uplo, n, nrhs, a, lda, afac,
527  $ lda, equed, s, b, lda, x, lda, rcond,
528  $ rwork, rwork( nrhs+1 ), work,
529  $ rwork( 2*nrhs+1 ), info )
530 *
531 * Check the error code from ZPOSVX.
532 *
533  IF( info.NE.izero ) THEN
534  CALL alaerh( path, 'ZPOSVX', info, izero,
535  $ fact // uplo, n, n, -1, -1, nrhs,
536  $ imat, nfail, nerrs, nout )
537  GO TO 90
538  END IF
539 *
540  IF( info.EQ.0 ) THEN
541  IF( .NOT.prefac ) THEN
542 *
543 * Reconstruct matrix from factors and compute
544 * residual.
545 *
546  CALL zpot01( uplo, n, a, lda, afac, lda,
547  $ rwork( 2*nrhs+1 ), result( 1 ) )
548  k1 = 1
549  ELSE
550  k1 = 2
551  END IF
552 *
553 * Compute residual of the computed solution.
554 *
555  CALL zlacpy( 'Full', n, nrhs, bsav, lda, work,
556  $ lda )
557  CALL zpot02( uplo, n, nrhs, asav, lda, x, lda,
558  $ work, lda, rwork( 2*nrhs+1 ),
559  $ result( 2 ) )
560 *
561 * Check solution from generated exact solution.
562 *
563  IF( nofact .OR. ( prefac .AND. lsame( equed,
564  $ 'N' ) ) ) THEN
565  CALL zget04( n, nrhs, x, lda, xact, lda,
566  $ rcondc, result( 3 ) )
567  ELSE
568  CALL zget04( n, nrhs, x, lda, xact, lda,
569  $ roldc, result( 3 ) )
570  END IF
571 *
572 * Check the error bounds from iterative
573 * refinement.
574 *
575  CALL zpot05( uplo, n, nrhs, asav, lda, b, lda,
576  $ x, lda, xact, lda, rwork,
577  $ rwork( nrhs+1 ), result( 4 ) )
578  ELSE
579  k1 = 6
580  END IF
581 *
582 * Compare RCOND from ZPOSVX with the computed value
583 * in RCONDC.
584 *
585  result( 6 ) = dget06( rcond, rcondc )
586 *
587 * Print information about the tests that did not pass
588 * the threshold.
589 *
590  DO 80 k = k1, 6
591  IF( result( k ).GE.thresh ) THEN
592  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
593  $ CALL aladhd( nout, path )
594  IF( prefac ) THEN
595  WRITE( nout, fmt = 9997 )'ZPOSVX', fact,
596  $ uplo, n, equed, imat, k, result( k )
597  ELSE
598  WRITE( nout, fmt = 9998 )'ZPOSVX', fact,
599  $ uplo, n, imat, k, result( k )
600  END IF
601  nfail = nfail + 1
602  END IF
603  80 CONTINUE
604  nrun = nrun + 7 - k1
605 *
606 * --- Test ZPOSVXX ---
607 *
608 * Restore the matrices A and B.
609 *
610  CALL zlacpy( 'Full', n, n, asav, lda, a, lda )
611  CALL zlacpy( 'Full', n, nrhs, bsav, lda, b, lda )
612 
613  IF( .NOT.prefac )
614  $ CALL zlaset( uplo, n, n, cmplx( zero ),
615  $ cmplx( zero ), afac, lda )
616  CALL zlaset( 'Full', n, nrhs, cmplx( zero ),
617  $ cmplx( zero ), x, lda )
618  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
619 *
620 * Equilibrate the matrix if FACT='F' and
621 * EQUED='Y'.
622 *
623  CALL zlaqhe( uplo, n, a, lda, s, scond, amax,
624  $ equed )
625  END IF
626 *
627 * Solve the system and compute the condition number
628 * and error bounds using ZPOSVXX.
629 *
630  srnamt = 'ZPOSVXX'
631  n_err_bnds = 3
632  CALL zposvxx( fact, uplo, n, nrhs, a, lda, afac,
633  $ lda, equed, s, b, lda, x,
634  $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
635  $ errbnds_n, errbnds_c, 0, zero, work,
636  $ rwork( 2*nrhs+1 ), info )
637 *
638 * Check the error code from ZPOSVXX.
639 *
640  IF( info.EQ.n+1 ) GOTO 90
641  IF( info.NE.izero ) THEN
642  CALL alaerh( path, 'ZPOSVXX', info, izero,
643  $ fact // uplo, n, n, -1, -1, nrhs,
644  $ imat, nfail, nerrs, nout )
645  GO TO 90
646  END IF
647 *
648  IF( info.EQ.0 ) THEN
649  IF( .NOT.prefac ) THEN
650 *
651 * Reconstruct matrix from factors and compute
652 * residual.
653 *
654  CALL zpot01( uplo, n, a, lda, afac, lda,
655  $ rwork( 2*nrhs+1 ), result( 1 ) )
656  k1 = 1
657  ELSE
658  k1 = 2
659  END IF
660 *
661 * Compute residual of the computed solution.
662 *
663  CALL zlacpy( 'Full', n, nrhs, bsav, lda, work,
664  $ lda )
665  CALL zpot02( uplo, n, nrhs, asav, lda, x, lda,
666  $ work, lda, rwork( 2*nrhs+1 ),
667  $ result( 2 ) )
668 *
669 * Check solution from generated exact solution.
670 *
671  IF( nofact .OR. ( prefac .AND. lsame( equed,
672  $ 'N' ) ) ) THEN
673  CALL zget04( n, nrhs, x, lda, xact, lda,
674  $ rcondc, result( 3 ) )
675  ELSE
676  CALL zget04( n, nrhs, x, lda, xact, lda,
677  $ roldc, result( 3 ) )
678  END IF
679 *
680 * Check the error bounds from iterative
681 * refinement.
682 *
683  CALL zpot05( uplo, n, nrhs, asav, lda, b, lda,
684  $ x, lda, xact, lda, rwork,
685  $ rwork( nrhs+1 ), result( 4 ) )
686  ELSE
687  k1 = 6
688  END IF
689 *
690 * Compare RCOND from ZPOSVXX with the computed value
691 * in RCONDC.
692 *
693  result( 6 ) = dget06( rcond, rcondc )
694 *
695 * Print information about the tests that did not pass
696 * the threshold.
697 *
698  DO 85 k = k1, 6
699  IF( result( k ).GE.thresh ) THEN
700  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
701  $ CALL aladhd( nout, path )
702  IF( prefac ) THEN
703  WRITE( nout, fmt = 9997 )'ZPOSVXX', fact,
704  $ uplo, n, equed, imat, k, result( k )
705  ELSE
706  WRITE( nout, fmt = 9998 )'ZPOSVXX', fact,
707  $ uplo, n, imat, k, result( k )
708  END IF
709  nfail = nfail + 1
710  END IF
711  85 CONTINUE
712  nrun = nrun + 7 - k1
713  90 CONTINUE
714  100 CONTINUE
715  110 CONTINUE
716  120 CONTINUE
717  130 CONTINUE
718 *
719 * Print a summary of the results.
720 *
721  CALL alasvm( path, nout, nfail, nrun, nerrs )
722 *
723 
724 * Test Error Bounds for ZGESVXX
725 
726  CALL zebchvxx(thresh, path)
727 
728  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i1,
729  $ ', test(', i1, ')=', g12.5 )
730  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N=', i5,
731  $ ', type ', i1, ', test(', i1, ')=', g12.5 )
732  9997 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N=', i5,
733  $ ', EQUED=''', a1, ''', type ', i1, ', test(', i1, ') =',
734  $ g12.5 )
735  RETURN
736 *
737 * End of ZDRVPO
738 *
739  END
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
Definition: zpotrf.f:102
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
Definition: zlaqhe.f:136
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:129
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
Definition: zlanhe.f:126
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zposv(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: zposv.f:132
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
subroutine zebchvxx(THRESH, PATH)
ZEBCHVXX
Definition: zebchvxx.f:98
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:80
subroutine zpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPOT01
Definition: zpot01.f:108
subroutine zpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQU
Definition: zpoequ.f:115
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:57
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine zposvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZPOSVXX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: zposvxx.f:495
subroutine zpotri(UPLO, N, A, LDA, INFO)
ZPOTRI
Definition: zpotri.f:97
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
Definition: zpot05.f:167
subroutine zposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: zposvx.f:308
subroutine zdrvpo(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
ZDRVPO
Definition: zdrvpo.f:161
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55