150 SUBROUTINE cdrvhe( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
151 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
160 INTEGER NMAX, NN, NOUT, NRHS
165 INTEGER IWORK( * ), NVAL( * )
167 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
168 $ work( * ), x( * ), xact( * )
175 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
176 INTEGER NTYPES, NTESTS
177 parameter( ntypes = 10, ntests = 6 )
179 parameter( nfact = 2 )
183 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
185 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
186 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
187 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
188 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC
191 CHARACTER FACTS( NFACT ), UPLOS( 2 )
192 INTEGER ISEED( 4 ), ISEEDY( 4 )
193 REAL RESULT( NTESTS )
197 EXTERNAL CLANHE, SGET06
211 COMMON / infoc / infot, nunit, ok, lerr
212 COMMON / srnamc / srnamt
215 INTRINSIC cmplx, max, min
218 DATA iseedy / 1988, 1989, 1990, 1991 /
219 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
225 path( 1: 1 ) =
'Complex precision'
231 iseed( i ) = iseedy( i )
233 lwork = max( 2*nmax, nmax*nrhs )
238 $
CALL cerrvx( path, nout )
258 DO 170 imat = 1, nimat
262 IF( .NOT.dotype( imat ) )
267 zerot = imat.GE.3 .AND. imat.LE.6
268 IF( zerot .AND. n.LT.imat-2 )
274 uplo = uplos( iuplo )
279 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
283 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
284 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
290 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
291 $ -1, -1, imat, nfail, nerrs, nout )
301 ELSE IF( imat.EQ.4 )
THEN
311 IF( iuplo.EQ.1 )
THEN
312 ioff = ( izero-1 )*lda
313 DO 20 i = 1, izero - 1
323 DO 40 i = 1, izero - 1
334 IF( iuplo.EQ.1 )
THEN
364 CALL claipd( n, a, lda+1, 0 )
366 DO 150 ifact = 1, nfact
370 fact = facts( ifact )
380 ELSE IF( ifact.EQ.1 )
THEN
384 anorm = clanhe(
'1', uplo, n, a, lda, rwork )
388 CALL clacpy( uplo, n, n, a, lda, afac, lda )
389 CALL chetrf( uplo, n, afac, lda, iwork, work,
394 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
395 lwork = (n+nb+1)*(nb+3)
396 CALL chetri2( uplo, n, ainv, lda, iwork, work,
398 ainvnm = clanhe(
'1', uplo, n, ainv, lda, rwork )
402 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
405 rcondc = ( one / anorm ) / ainvnm
412 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
413 $ nrhs, a, lda, xact, lda, b, lda, iseed,
419 IF( ifact.EQ.2 )
THEN
420 CALL clacpy( uplo, n, n, a, lda, afac, lda )
421 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
426 CALL chesv( uplo, n, nrhs, afac, lda, iwork, x,
427 $ lda, work, lwork, info )
435 IF( iwork( k ).LT.0 )
THEN
436 IF( iwork( k ).NE.-k )
THEN
440 ELSE IF( iwork( k ).NE.k )
THEN
449 CALL alaerh( path,
'CHESV ', info, k, uplo, n,
450 $ n, -1, -1, nrhs, imat, nfail,
453 ELSE IF( info.NE.0 )
THEN
460 CALL chet01( uplo, n, a, lda, afac, lda, iwork,
461 $ ainv, lda, rwork, result( 1 ) )
465 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
466 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
467 $ lda, rwork, result( 2 ) )
471 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
479 IF( result( k ).GE.thresh )
THEN
480 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
481 $
CALL aladhd( nout, path )
482 WRITE( nout, fmt = 9999 )
'CHESV ', uplo, n,
483 $ imat, k, result( k )
494 $
CALL claset( uplo, n, n, cmplx( zero ),
495 $ cmplx( zero ), afac, lda )
496 CALL claset(
'Full', n, nrhs, cmplx( zero ),
497 $ cmplx( zero ), x, lda )
503 CALL chesvx( fact, uplo, n, nrhs, a, lda, afac, lda,
504 $ iwork, b, lda, x, lda, rcond, rwork,
505 $ rwork( nrhs+1 ), work, lwork,
506 $ rwork( 2*nrhs+1 ), info )
514 IF( iwork( k ).LT.0 )
THEN
515 IF( iwork( k ).NE.-k )
THEN
519 ELSE IF( iwork( k ).NE.k )
THEN
528 CALL alaerh( path,
'CHESVX', info, k, fact // uplo,
529 $ n, n, -1, -1, nrhs, imat, nfail,
535 IF( ifact.GE.2 )
THEN
540 CALL chet01( uplo, n, a, lda, afac, lda, iwork,
541 $ ainv, lda, rwork( 2*nrhs+1 ),
550 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
551 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
552 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
556 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
561 CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
562 $ xact, lda, rwork, rwork( nrhs+1 ),
571 result( 6 ) = sget06( rcond, rcondc )
577 IF( result( k ).GE.thresh )
THEN
578 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
579 $
CALL aladhd( nout, path )
580 WRITE( nout, fmt = 9998 )
'CHESVX', fact, uplo,
581 $ n, imat, k, result( k )
595 CALL alasvm( path, nout, nfail, nrun, nerrs )
597 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
598 $
', test ', i2,
', ratio =', g12.5 )
599 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
600 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )