159 SUBROUTINE zdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
160 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
169 INTEGER NMAX, NN, NOUT, NRHS
170 DOUBLE PRECISION THRESH
175 DOUBLE PRECISION RWORK( * ), S( * )
176 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
177 $ bsav( * ), work( * ), x( * ), xact( * )
183 DOUBLE PRECISION ONE, ZERO
184 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
186 parameter( ntypes = 9 )
188 parameter( ntests = 6 )
191 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
192 CHARACTER DIST, EQUED, FACT,
TYPE, UPLO, XTYPE
194 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
195 $ izero, k, k1, kl, ku, lda, mode, n, nb, nbmin,
196 $ nerrs, nfact, nfail, nimat, nrun, nt,
198 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
199 $ ROLDC, SCOND, RPVGRW_SVXX
202 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
203 INTEGER ISEED( 4 ), ISEEDY( 4 )
204 DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ),
205 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
209 DOUBLE PRECISION DGET06, ZLANHE
210 EXTERNAL lsame, dget06, zlanhe
224 COMMON / infoc / infot, nunit, ok, lerr
225 COMMON / srnamc / srnamt
228 INTRINSIC dcmplx, max
231 DATA iseedy / 1988, 1989, 1990, 1991 /
232 DATA uplos /
'U',
'L' /
233 DATA facts /
'F',
'N',
'E' /
234 DATA equeds /
'N',
'Y' /
240 path( 1: 1 ) =
'Zomplex precision'
246 iseed( i ) = iseedy( i )
252 $
CALL zerrvx( path, nout )
272 DO 120 imat = 1, nimat
276 IF( .NOT.dotype( imat ) )
281 zerot = imat.GE.3 .AND. imat.LE.5
282 IF( zerot .AND. n.LT.imat-2 )
288 uplo = uplos( iuplo )
293 CALL zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
297 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode,
298 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
304 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
305 $ -1, -1, imat, nfail, nerrs, nout )
315 ELSE IF( imat.EQ.4 )
THEN
320 ioff = ( izero-1 )*lda
324 IF( iuplo.EQ.1 )
THEN
325 DO 20 i = 1, izero - 1
335 DO 40 i = 1, izero - 1
350 CALL zlaipd( n, a, lda+1, 0 )
354 CALL zlacpy( uplo, n, n, a, lda, asav, lda )
357 equed = equeds( iequed )
358 IF( iequed.EQ.1 )
THEN
364 DO 90 ifact = 1, nfact
365 fact = facts( ifact )
366 prefac = lsame( fact,
'F' )
367 nofact = lsame( fact,
'N' )
368 equil = lsame( fact,
'E' )
375 ELSE IF( .NOT.lsame( fact,
'N' ) )
THEN
382 CALL zlacpy( uplo, n, n, asav, lda, afac, lda )
383 IF( equil .OR. iequed.GT.1 )
THEN
388 CALL zpoequ( n, afac, lda, s, scond, amax,
390 IF( info.EQ.0 .AND. n.GT.0 )
THEN
396 CALL zlaqhe( uplo, n, afac, lda, s, scond,
409 anorm = zlanhe(
'1', uplo, n, afac, lda, rwork )
413 CALL zpotrf( uplo, n, afac, lda, info )
417 CALL zlacpy( uplo, n, n, afac, lda, a, lda )
418 CALL zpotri( uplo, n, a, lda, info )
422 ainvnm = zlanhe(
'1', uplo, n, a, lda, rwork )
423 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
426 rcondc = ( one / anorm ) / ainvnm
432 CALL zlacpy( uplo, n, n, asav, lda, a, lda )
437 CALL zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
438 $ nrhs, a, lda, xact, lda, b, lda,
441 CALL zlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
450 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
451 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
454 CALL zposv( uplo, n, nrhs, afac, lda, x, lda,
459 IF( info.NE.izero )
THEN
460 CALL alaerh( path,
'ZPOSV ', info, izero,
461 $ uplo, n, n, -1, -1, nrhs, imat,
462 $ nfail, nerrs, nout )
464 ELSE IF( info.NE.0 )
THEN
471 CALL zpot01( uplo, n, a, lda, afac, lda, rwork,
476 CALL zlacpy(
'Full', n, nrhs, b, lda, work,
478 CALL zpot02( uplo, n, nrhs, a, lda, x, lda,
479 $ work, lda, rwork, result( 2 ) )
483 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
491 IF( result( k ).GE.thresh )
THEN
492 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
493 $
CALL aladhd( nout, path )
494 WRITE( nout, fmt = 9999 )
'ZPOSV ', uplo,
495 $ n, imat, k, result( k )
506 $
CALL zlaset( uplo, n, n, dcmplx( zero ),
507 $ dcmplx( zero ), afac, lda )
508 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
509 $ dcmplx( zero ), x, lda )
510 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
515 CALL zlaqhe( uplo, n, a, lda, s, scond, amax,
523 CALL zposvx( fact, uplo, n, nrhs, a, lda, afac,
524 $ lda, equed, s, b, lda, x, lda, rcond,
525 $ rwork, rwork( nrhs+1 ), work,
526 $ rwork( 2*nrhs+1 ), info )
530 IF( info.NE.izero )
THEN
531 CALL alaerh( path,
'ZPOSVX', info, izero,
532 $ fact // uplo, n, n, -1, -1, nrhs,
533 $ imat, nfail, nerrs, nout )
538 IF( .NOT.prefac )
THEN
543 CALL zpot01( uplo, n, a, lda, afac, lda,
544 $ rwork( 2*nrhs+1 ), result( 1 ) )
552 CALL zlacpy(
'Full', n, nrhs, bsav, lda, work,
554 CALL zpot02( uplo, n, nrhs, asav, lda, x, lda,
555 $ work, lda, rwork( 2*nrhs+1 ),
560 IF( nofact .OR. ( prefac .AND. lsame( equed,
562 CALL zget04( n, nrhs, x, lda, xact, lda,
563 $ rcondc, result( 3 ) )
565 CALL zget04( n, nrhs, x, lda, xact, lda,
566 $ roldc, result( 3 ) )
572 CALL zpot05( uplo, n, nrhs, asav, lda, b, lda,
573 $ x, lda, xact, lda, rwork,
574 $ rwork( nrhs+1 ), result( 4 ) )
582 result( 6 ) = dget06( rcond, rcondc )
588 IF( result( k ).GE.thresh )
THEN
589 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
590 $
CALL aladhd( nout, path )
592 WRITE( nout, fmt = 9997 )
'ZPOSVX', fact,
593 $ uplo, n, equed, imat, k, result( k )
595 WRITE( nout, fmt = 9998 )
'ZPOSVX', fact,
596 $ uplo, n, imat, k, result( k )
607 CALL zlacpy(
'Full', n, n, asav, lda, a, lda )
608 CALL zlacpy(
'Full', n, nrhs, bsav, lda, b, lda )
611 $
CALL zlaset( uplo, n, n, dcmplx( zero ),
612 $ dcmplx( zero ), afac, lda )
613 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
614 $ dcmplx( zero ), x, lda )
615 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
620 CALL zlaqhe( uplo, n, a, lda, s, scond, amax,
629 CALL zposvxx( fact, uplo, n, nrhs, a, lda, afac,
630 $ lda, equed, s, b, lda, x,
631 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
632 $ errbnds_n, errbnds_c, 0, zero, work,
633 $ rwork( 2*nrhs+1 ), info )
637 IF( info.EQ.n+1 )
GOTO 90
638 IF( info.NE.izero )
THEN
639 CALL alaerh( path,
'ZPOSVXX', info, izero,
640 $ fact // uplo, n, n, -1, -1, nrhs,
641 $ imat, nfail, nerrs, nout )
646 IF( .NOT.prefac )
THEN
651 CALL zpot01( uplo, n, a, lda, afac, lda,
652 $ rwork( 2*nrhs+1 ), result( 1 ) )
660 CALL zlacpy(
'Full', n, nrhs, bsav, lda, work,
662 CALL zpot02( uplo, n, nrhs, asav, lda, x, lda,
663 $ work, lda, rwork( 2*nrhs+1 ),
668 IF( nofact .OR. ( prefac .AND. lsame( equed,
670 CALL zget04( n, nrhs, x, lda, xact, lda,
671 $ rcondc, result( 3 ) )
673 CALL zget04( n, nrhs, x, lda, xact, lda,
674 $ roldc, result( 3 ) )
680 CALL zpot05( uplo, n, nrhs, asav, lda, b, lda,
681 $ x, lda, xact, lda, rwork,
682 $ rwork( nrhs+1 ), result( 4 ) )
690 result( 6 ) = dget06( rcond, rcondc )
696 IF( result( k ).GE.thresh )
THEN
697 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
698 $
CALL aladhd( nout, path )
700 WRITE( nout, fmt = 9997 )
'ZPOSVXX', fact,
701 $ uplo, n, equed, imat, k, result( k )
703 WRITE( nout, fmt = 9998 )
'ZPOSVXX', fact,
704 $ uplo, n, imat, k, result( k )
718 CALL alasvm( path, nout, nfail, nrun, nerrs )
725 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
726 $
', test(', i1,
')=', g12.5 )
727 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
728 $
', type ', i1,
', test(', i1,
')=', g12.5 )
729 9997
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
730 $
', 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 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
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 zebchvxx(thresh, path)
ZEBCHVXX
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