156 SUBROUTINE zdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
166 INTEGER NMAX, NN, NOUT, NRHS
167 DOUBLE PRECISION THRESH
172 DOUBLE PRECISION RWORK( * ), S( * )
173 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
174 $ bsav( * ), work( * ), x( * ), xact( * )
180 DOUBLE PRECISION ONE, ZERO
181 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
183 parameter( ntypes = 9 )
185 parameter( ntests = 6 )
188 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
189 CHARACTER DIST, EQUED, FACT,
TYPE, UPLO, XTYPE
191 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
192 $ izero, k, k1, kl, ku, lda, mode, n, nb, nbmin,
193 $ nerrs, nfact, nfail, nimat, nrun, nt
194 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
198 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
199 INTEGER ISEED( 4 ), ISEEDY( 4 )
200 DOUBLE PRECISION RESULT( NTESTS )
204 DOUBLE PRECISION DGET06, ZLANHE
205 EXTERNAL lsame, dget06, zlanhe
219 COMMON / infoc / infot, nunit, ok, lerr
220 COMMON / srnamc / srnamt
223 INTRINSIC dcmplx, max
226 DATA iseedy / 1988, 1989, 1990, 1991 /
227 DATA uplos /
'U',
'L' /
228 DATA facts /
'F',
'N',
'E' /
229 DATA equeds /
'N',
'Y' /
235 path( 1: 1 ) =
'Zomplex precision'
241 iseed( i ) = iseedy( i )
247 $
CALL zerrvx( path, nout )
267 DO 120 imat = 1, nimat
271 IF( .NOT.dotype( imat ) )
276 zerot = imat.GE.3 .AND. imat.LE.5
277 IF( zerot .AND. n.LT.imat-2 )
283 uplo = uplos( iuplo )
288 CALL zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
292 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode,
293 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
299 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
300 $ -1, -1, imat, nfail, nerrs, nout )
310 ELSE IF( imat.EQ.4 )
THEN
315 ioff = ( izero-1 )*lda
319 IF( iuplo.EQ.1 )
THEN
320 DO 20 i = 1, izero - 1
330 DO 40 i = 1, izero - 1
345 CALL zlaipd( n, a, lda+1, 0 )
349 CALL zlacpy( uplo, n, n, a, lda, asav, lda )
352 equed = equeds( iequed )
353 IF( iequed.EQ.1 )
THEN
359 DO 90 ifact = 1, nfact
360 fact = facts( ifact )
361 prefac = lsame( fact,
'F' )
362 nofact = lsame( fact,
'N' )
363 equil = lsame( fact,
'E' )
370 ELSE IF( .NOT.lsame( fact,
'N' ) )
THEN
377 CALL zlacpy( uplo, n, n, asav, lda, afac, lda )
378 IF( equil .OR. iequed.GT.1 )
THEN
383 CALL zpoequ( n, afac, lda, s, scond, amax,
385 IF( info.EQ.0 .AND. n.GT.0 )
THEN
391 CALL zlaqhe( uplo, n, afac, lda, s, scond,
404 anorm = zlanhe(
'1', uplo, n, afac, lda, rwork )
408 CALL zpotrf( uplo, n, afac, lda, info )
412 CALL zlacpy( uplo, n, n, afac, lda, a, lda )
413 CALL zpotri( uplo, n, a, lda, info )
417 ainvnm = zlanhe(
'1', uplo, n, a, lda, rwork )
418 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondc = ( one / anorm ) / ainvnm
427 CALL zlacpy( uplo, n, n, asav, lda, a, lda )
432 CALL zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
433 $ nrhs, a, lda, xact, lda, b, lda,
436 CALL zlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
445 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
446 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
449 CALL zposv( uplo, n, nrhs, afac, lda, x, lda,
454 IF( info.NE.izero )
THEN
455 CALL alaerh( path,
'ZPOSV ', info, izero,
456 $ uplo, n, n, -1, -1, nrhs, imat,
457 $ nfail, nerrs, nout )
459 ELSE IF( info.NE.0 )
THEN
466 CALL zpot01( uplo, n, a, lda, afac, lda, rwork,
471 CALL zlacpy(
'Full', n, nrhs, b, lda, work,
473 CALL zpot02( uplo, n, nrhs, a, lda, x, lda,
474 $ work, lda, rwork, result( 2 ) )
478 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
486 IF( result( k ).GE.thresh )
THEN
487 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
488 $
CALL aladhd( nout, path )
489 WRITE( nout, fmt = 9999 )
'ZPOSV ', uplo,
490 $ n, imat, k, result( k )
501 $
CALL zlaset( uplo, n, n, dcmplx( zero ),
502 $ dcmplx( zero ), afac, lda )
503 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
504 $ dcmplx( zero ), x, lda )
505 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
510 CALL zlaqhe( uplo, n, a, lda, s, scond, amax,
518 CALL zposvx( fact, uplo, n, nrhs, a, lda, afac,
519 $ lda, equed, s, b, lda, x, lda, rcond,
520 $ rwork, rwork( nrhs+1 ), work,
521 $ rwork( 2*nrhs+1 ), info )
525 IF( info.NE.izero )
THEN
526 CALL alaerh( path,
'ZPOSVX', info, izero,
527 $ fact // uplo, n, n, -1, -1, nrhs,
528 $ imat, nfail, nerrs, nout )
533 IF( .NOT.prefac )
THEN
538 CALL zpot01( uplo, n, a, lda, afac, lda,
539 $ rwork( 2*nrhs+1 ), result( 1 ) )
547 CALL zlacpy(
'Full', n, nrhs, bsav, lda, work,
549 CALL zpot02( uplo, n, nrhs, asav, lda, x, lda,
550 $ work, lda, rwork( 2*nrhs+1 ),
555 IF( nofact .OR. ( prefac .AND. lsame( equed,
557 CALL zget04( n, nrhs, x, lda, xact, lda,
558 $ rcondc, result( 3 ) )
560 CALL zget04( n, nrhs, x, lda, xact, lda,
561 $ roldc, result( 3 ) )
567 CALL zpot05( uplo, n, nrhs, asav, lda, b, lda,
568 $ x, lda, xact, lda, rwork,
569 $ rwork( nrhs+1 ), result( 4 ) )
577 result( 6 ) = dget06( rcond, rcondc )
583 IF( result( k ).GE.thresh )
THEN
584 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
585 $
CALL aladhd( nout, path )
587 WRITE( nout, fmt = 9997 )
'ZPOSVX', fact,
588 $ uplo, n, equed, imat, k, result( k )
590 WRITE( nout, fmt = 9998 )
'ZPOSVX', fact,
591 $ uplo, n, imat, k, result( k )
605 CALL alasvm( path, nout, nfail, nrun, nerrs )
607 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
608 $
', test(', i1,
')=', g12.5 )
609 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
610 $
', type ', i1,
', test(', i1,
')=', g12.5 )
611 9997
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
612 $
', EQUED=''', a1,
''', type ', i1,
', test(', i1,
') =',
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine zlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
ZLARHS
subroutine aladhd(iounit, path)
ALADHD
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlaqhe(uplo, n, a, lda, s, scond, amax, equed)
ZLAQHE scales a Hermitian matrix.
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.
subroutine zpoequ(n, a, lda, s, scond, amax, info)
ZPOEQU
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
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
subroutine zpotrf(uplo, n, a, lda, info)
ZPOTRF
subroutine zpotri(uplo, n, a, lda, info)
ZPOTRI
subroutine zdrvpo(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, nout)
ZDRVPO
subroutine zerrvx(path, nunit)
ZERRVX
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
subroutine zlaipd(n, a, inda, vinda)
ZLAIPD
subroutine zlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
ZLATB4
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS
subroutine zpot01(uplo, n, a, lda, afac, ldafac, rwork, resid)
ZPOT01
subroutine zpot02(uplo, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
ZPOT02
subroutine zpot05(uplo, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
ZPOT05