158 SUBROUTINE zdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
159 $ 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
197 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
201 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
202 INTEGER ISEED( 4 ), ISEEDY( 4 )
203 DOUBLE PRECISION RESULT( ntests )
207 DOUBLE PRECISION DGET06, ZLANHE
208 EXTERNAL lsame, dget06, zlanhe
222 COMMON / infoc / infot, nunit, ok, lerr
223 COMMON / srnamc / srnamt
226 INTRINSIC dcmplx, max
229 DATA iseedy / 1988, 1989, 1990, 1991 /
230 DATA uplos /
'U',
'L' /
231 DATA facts /
'F',
'N',
'E' /
232 DATA equeds /
'N',
'Y' /
238 path( 1: 1 ) =
'Zomplex precision'
244 iseed( i ) = iseedy( i )
250 $
CALL zerrvx( path, nout )
270 DO 120 imat = 1, nimat
274 IF( .NOT.dotype( imat ) )
279 zerot = imat.GE.3 .AND. imat.LE.5
280 IF( zerot .AND. n.LT.imat-2 )
286 uplo = uplos( iuplo )
291 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
295 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
296 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
302 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
303 $ -1, -1, imat, nfail, nerrs, nout )
313 ELSE IF( imat.EQ.4 )
THEN
318 ioff = ( izero-1 )*lda
322 IF( iuplo.EQ.1 )
THEN
323 DO 20 i = 1, izero - 1
333 DO 40 i = 1, izero - 1
348 CALL zlaipd( n, a, lda+1, 0 )
352 CALL zlacpy( uplo, n, n, a, lda, asav, lda )
355 equed = equeds( iequed )
356 IF( iequed.EQ.1 )
THEN
362 DO 90 ifact = 1, nfact
363 fact = facts( ifact )
364 prefac = lsame( fact,
'F' )
365 nofact = lsame( fact,
'N' )
366 equil = lsame( fact,
'E' )
373 ELSE IF( .NOT.lsame( fact,
'N' ) )
THEN
380 CALL zlacpy( uplo, n, n, asav, lda, afac, lda )
381 IF( equil .OR. iequed.GT.1 )
THEN
386 CALL zpoequ( n, afac, lda, s, scond, amax,
388 IF( info.EQ.0 .AND. n.GT.0 )
THEN
394 CALL zlaqhe( uplo, n, afac, lda, s, scond,
407 anorm = zlanhe(
'1', uplo, n, afac, lda, rwork )
411 CALL zpotrf( uplo, n, afac, lda, info )
415 CALL zlacpy( uplo, n, n, afac, lda, a, lda )
416 CALL zpotri( uplo, n, a, lda, info )
420 ainvnm = zlanhe(
'1', uplo, n, a, lda, rwork )
421 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
424 rcondc = ( one / anorm ) / ainvnm
430 CALL zlacpy( uplo, n, n, asav, lda, a, lda )
435 CALL zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
436 $ nrhs, a, lda, xact, lda, b, lda,
439 CALL zlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
448 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
449 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
452 CALL zposv( uplo, n, nrhs, afac, lda, x, lda,
457 IF( info.NE.izero )
THEN
458 CALL alaerh( path,
'ZPOSV ', info, izero,
459 $ uplo, n, n, -1, -1, nrhs, imat,
460 $ nfail, nerrs, nout )
462 ELSE IF( info.NE.0 )
THEN
469 CALL zpot01( uplo, n, a, lda, afac, lda, rwork,
474 CALL zlacpy(
'Full', n, nrhs, b, lda, work,
476 CALL zpot02( uplo, n, nrhs, a, lda, x, lda,
477 $ work, lda, rwork, result( 2 ) )
481 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
489 IF( result( k ).GE.thresh )
THEN
490 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491 $
CALL aladhd( nout, path )
492 WRITE( nout, fmt = 9999 )
'ZPOSV ', uplo,
493 $ n, imat, k, result( k )
504 $
CALL zlaset( uplo, n, n, dcmplx( zero ),
505 $ dcmplx( zero ), afac, lda )
506 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
507 $ dcmplx( zero ), x, lda )
508 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
513 CALL zlaqhe( uplo, n, a, lda, s, scond, amax,
521 CALL zposvx( fact, uplo, n, nrhs, a, lda, afac,
522 $ lda, equed, s, b, lda, x, lda, rcond,
523 $ rwork, rwork( nrhs+1 ), work,
524 $ rwork( 2*nrhs+1 ), info )
528 IF( info.NE.izero )
THEN
529 CALL alaerh( path,
'ZPOSVX', info, izero,
530 $ fact // uplo, n, n, -1, -1, nrhs,
531 $ imat, nfail, nerrs, nout )
536 IF( .NOT.prefac )
THEN
541 CALL zpot01( uplo, n, a, lda, afac, lda,
542 $ rwork( 2*nrhs+1 ), result( 1 ) )
550 CALL zlacpy(
'Full', n, nrhs, bsav, lda, work,
552 CALL zpot02( uplo, n, nrhs, asav, lda, x, lda,
553 $ work, lda, rwork( 2*nrhs+1 ),
558 IF( nofact .OR. ( prefac .AND. lsame( equed,
560 CALL zget04( n, nrhs, x, lda, xact, lda,
561 $ rcondc, result( 3 ) )
563 CALL zget04( n, nrhs, x, lda, xact, lda,
564 $ roldc, result( 3 ) )
570 CALL zpot05( uplo, n, nrhs, asav, lda, b, lda,
571 $ x, lda, xact, lda, rwork,
572 $ rwork( nrhs+1 ), result( 4 ) )
580 result( 6 ) = dget06( rcond, rcondc )
586 IF( result( k ).GE.thresh )
THEN
587 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
588 $
CALL aladhd( nout, path )
590 WRITE( nout, fmt = 9997 )
'ZPOSVX', fact,
591 $ uplo, n, equed, imat, k, result( k )
593 WRITE( nout, fmt = 9998 )
'ZPOSVX', fact,
594 $ uplo, n, imat, k, result( k )
608 CALL alasvm( path, nout, nfail, nrun, nerrs )
610 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
611 $
', test(', i1,
')=', g12.5 )
612 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
613 $
', type ', i1,
', test(', i1,
')=', g12.5 )
614 9997
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
615 $
', EQUED=''', a1,
''', type ', i1,
', test(', i1,
') =',
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
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 zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine aladhd(IOUNIT, PATH)
ALADHD
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 zpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPOT01
subroutine zpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQU
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zpotri(UPLO, N, A, LDA, INFO)
ZPOTRI
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
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 zdrvpo(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
ZDRVPO