172 $ thresh, tsterr, nmax, a, afac, ainv,
b, x,
173 $ xact, work, rwork, iwork, nout )
182 INTEGER nmax, nn, nnb, nns, nout
187 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
189 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
190 $ work( * ), x( * ), xact( * )
197 parameter( zero = 0.0e+0, one = 1.0e+0 )
199 parameter( onehalf = 0.5e+0 )
201 parameter( eight = 8.0e+0, sevten = 17.0e+0 )
203 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
205 parameter( ntypes = 10 )
207 parameter( ntests = 7 )
210 LOGICAL trfcon, zerot
211 CHARACTER dist, type, uplo, xtype
212 CHARACTER*3 path, matpath
213 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
214 $ itemp, itemp2, iuplo, izero,
j, k, kl, ku, lda,
215 $ lwork, mode, n, nb, nerrs, nfail, nimat, nrhs,
217 REAL alpha, anorm, cndnum, const, lam_max, lam_min,
218 $ rcond, rcondc, stemp
222 INTEGER iseed( 4 ), iseedy( 4 ), idummy( 1 )
223 REAL result( ntests )
237 INTRINSIC abs, max, min, sqrt
245 COMMON / infoc / infot, nunit, ok, lerr
246 COMMON / srnamc / srnamt
249 DATA iseedy / 1988, 1989, 1990, 1991 /
250 DATA uplos /
'U',
'L' /
256 alpha = ( one+sqrt( sevten ) ) / eight
260 path( 1: 1 ) =
'Complex precision'
265 matpath( 1: 1 ) =
'Complex precision'
266 matpath( 2: 3 ) =
'HE'
272 iseed( i ) = iseedy( i )
278 $ CALL
cerrhe( path, nout )
300 DO 260 imat = 1, nimat
304 IF( .NOT.dotype( imat ) )
309 zerot = imat.GE.3 .AND. imat.LE.6
310 IF( zerot .AND. n.LT.imat-2 )
316 uplo = uplos( iuplo )
323 CALL
clatb4( matpath, imat, n, n, type, kl, ku, anorm,
324 $ mode, cndnum, dist )
329 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
330 $ cndnum, anorm, kl, ku, uplo, a, lda,
336 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n,
337 $ -1, -1, -1, imat, nfail, nerrs, nout )
351 ELSE IF( imat.EQ.4 )
THEN
361 IF( iuplo.EQ.1 )
THEN
362 ioff = ( izero-1 )*lda
363 DO 20 i = 1, izero - 1
373 DO 40 i = 1, izero - 1
383 IF( iuplo.EQ.1 )
THEN
430 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
437 lwork = max( 2, nb )*lda
438 srnamt =
'CHETRF_ROOK'
448 IF( iwork( k ).LT.0 )
THEN
449 IF( iwork( k ).NE.-k )
THEN
453 ELSE IF( iwork( k ).NE.k )
THEN
462 $ CALL
alaerh( path,
'CHETRF_ROOK', info, k,
463 $ uplo, n, n, -1, -1, nb, imat,
464 $ nfail, nerrs, nout )
477 CALL
chet01_rook( uplo, n, a, lda, afac, lda, iwork,
478 $ ainv, lda, rwork, result( 1 ) )
487 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
488 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
489 srnamt =
'CHETRI_ROOK'
496 $ CALL
alaerh( path,
'CHETRI_ROOK', info, -1,
497 $ uplo, n, n, -1, -1, -1, imat,
498 $ nfail, nerrs, nout )
503 CALL
cpot03( uplo, n, a, lda, ainv, lda, work, lda,
504 $ rwork, rcondc, result( 2 ) )
512 IF( result( k ).GE.thresh )
THEN
513 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
514 $ CALL
alahd( nout, path )
515 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
528 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) ) /
531 IF( iuplo.EQ.1 )
THEN
540 IF( iwork( k ).GT.zero )
THEN
545 stemp =
clange(
'M', k-1, 1,
546 $ afac( ( k-1 )*lda+1 ), lda, rwork )
552 stemp =
clange(
'M', k-2, 2,
553 $ afac( ( k-2 )*lda+1 ), lda, rwork )
560 stemp = stemp - const + thresh
561 IF( stemp.GT.result( 3 ) )
562 $ result( 3 ) = stemp
578 IF( iwork( k ).GT.zero )
THEN
583 stemp =
clange(
'M', n-k, 1,
584 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
590 stemp =
clange(
'M', n-k-1, 2,
591 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
598 stemp = stemp - const + thresh
599 IF( stemp.GT.result( 3 ) )
600 $ result( 3 ) = stemp
615 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
616 $ ( ( one + alpha ) / ( one - alpha ) )
617 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
619 IF( iuplo.EQ.1 )
THEN
628 IF( iwork( k ).LT.zero )
THEN
633 CALL
cheevx(
'N',
'A', uplo, 2,
634 $ ainv( ( k-2 )*lda+k-1 ), lda,stemp,
635 $ stemp, itemp, itemp, zero, itemp,
636 $ rwork, cdummy, 1, work, 16,
637 $ rwork( 3 ), iwork( n+1 ), idummy,
640 lam_max = max( abs( rwork( 1 ) ),
641 $ abs( rwork( 2 ) ) )
642 lam_min = min( abs( rwork( 1 ) ),
643 $ abs( rwork( 2 ) ) )
645 stemp = lam_max / lam_min
649 stemp = abs( stemp ) - const + thresh
650 IF( stemp.GT.result( 4 ) )
651 $ result( 4 ) = stemp
670 IF( iwork( k ).LT.zero )
THEN
675 CALL
cheevx(
'N',
'A', uplo, 2,
676 $ ainv( ( k-1 )*lda+k ), lda, stemp,
677 $ stemp, itemp, itemp, zero, itemp,
678 $ rwork, cdummy, 1, work, 16,
679 $ rwork( 3 ), iwork( n+1 ), idummy,
682 lam_max = max( abs( rwork( 1 ) ),
683 $ abs( rwork( 2 ) ) )
684 lam_min = min( abs( rwork( 1 ) ),
685 $ abs( rwork( 2 ) ) )
687 stemp = lam_max / lam_min
691 stemp = abs( stemp ) - const + thresh
692 IF( stemp.GT.result( 4 ) )
693 $ result( 4 ) = stemp
708 IF( result( k ).GE.thresh )
THEN
709 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
710 $ CALL
alahd( nout, path )
711 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
746 CALL
clarhs( matpath, xtype, uplo,
' ', n, n,
747 $ kl, ku, nrhs, a, lda, xact, lda,
748 $
b, lda, iseed, info )
749 CALL
clacpy(
'Full', n, nrhs,
b, lda, x, lda )
751 srnamt =
'CHETRS_ROOK'
758 $ CALL
alaerh( path,
'CHETRS_ROOK', info, 0,
759 $ uplo, n, n, -1, -1, nrhs, imat,
760 $ nfail, nerrs, nout )
762 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
766 CALL
cpot02( uplo, n, nrhs, a, lda, x, lda, work,
767 $ lda, rwork, result( 5 ) )
772 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
779 IF( result( k ).GE.thresh )
THEN
780 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
781 $ CALL
alahd( nout, path )
782 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
783 $ imat, k, result( k )
797 anorm =
clanhe(
'1', uplo, n, a, lda, rwork )
798 srnamt =
'CHECON_ROOK'
799 CALL
checon_rook( uplo, n, afac, lda, iwork, anorm,
800 $ rcond, work, info )
805 $ CALL
alaerh( path,
'CHECON_ROOK', info, 0,
806 $ uplo, n, n, -1, -1, -1, imat,
807 $ nfail, nerrs, nout )
811 result( 7 ) =
sget06( rcond, rcondc )
816 IF( result( 7 ).GE.thresh )
THEN
817 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
818 $ CALL
alahd( nout, path )
819 WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
832 CALL
alasum( path, nout, nfail, nrun, nerrs )
834 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
835 $ i2,
', test ', i2,
', ratio =', g12.5 )
836 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
837 $ i2,
', test ', i2,
', ratio =', g12.5 )
838 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
839 $
', test ', i2,
', ratio =', g12.5 )