170 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
171 $ XACT, WORK, RWORK, IWORK, NOUT )
179 INTEGER NMAX, NN, NNB, NNS, NOUT
184 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
186 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
187 $ work( * ), x( * ), xact( * )
194 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
196 parameter( onehalf = 0.5e+0 )
198 parameter( eight = 8.0e+0, sevten = 17.0e+0 )
200 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
202 parameter( ntypes = 10 )
204 parameter( ntests = 7 )
207 LOGICAL TRFCON, ZEROT
208 CHARACTER DIST,
TYPE, UPLO, XTYPE
209 CHARACTER*3 PATH, MATPATH
210 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
211 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
212 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
213 REAL ALPHA, ANORM, CNDNUM, CONST, SING_MAX,
214 $ SING_MIN, RCOND, RCONDC, STEMP
218 INTEGER ISEED( 4 ), ISEEDY( 4 )
219 REAL RESULT( NTESTS )
220 COMPLEX BLOCK( 2, 2 ), CDUMMY( 1 )
223 REAL CLANGE, CLANHE, SGET06
224 EXTERNAL CLANGE, CLANHE, SGET06
233 INTRINSIC conjg, max, min, sqrt
241 COMMON / infoc / infot, nunit, ok, lerr
242 COMMON / srnamc / srnamt
245 DATA iseedy / 1988, 1989, 1990, 1991 /
246 DATA uplos /
'U',
'L' /
252 alpha = ( one+sqrt( sevten ) ) / eight
256 path( 1: 1 ) =
'Complex precision'
261 matpath( 1: 1 ) =
'Complex precision'
262 matpath( 2: 3 ) =
'HE'
268 iseed( i ) = iseedy( i )
274 $
CALL cerrhe( path, nout )
296 DO 260 imat = 1, nimat
300 IF( .NOT.dotype( imat ) )
305 zerot = imat.GE.3 .AND. imat.LE.6
306 IF( zerot .AND. n.LT.imat-2 )
312 uplo = uplos( iuplo )
319 CALL clatb4( matpath, imat, n, n,
TYPE, kl, ku, anorm,
320 $ mode, cndnum, dist )
325 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
326 $ cndnum, anorm, kl, ku, uplo, a, lda,
332 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
333 $ -1, -1, -1, imat, nfail, nerrs, nout )
347 ELSE IF( imat.EQ.4 )
THEN
357 IF( iuplo.EQ.1 )
THEN
358 ioff = ( izero-1 )*lda
359 DO 20 i = 1, izero - 1
369 DO 40 i = 1, izero - 1
379 IF( iuplo.EQ.1 )
THEN
426 CALL clacpy( uplo, n, n, a, lda, afac, lda )
433 lwork = max( 2, nb )*lda
434 srnamt =
'CHETRF_ROOK'
444 IF( iwork( k ).LT.0 )
THEN
445 IF( iwork( k ).NE.-k )
THEN
449 ELSE IF( iwork( k ).NE.k )
THEN
458 $
CALL alaerh( path,
'CHETRF_ROOK', info, k,
459 $ uplo, n, n, -1, -1, nb, imat,
460 $ nfail, nerrs, nout )
473 CALL chet01_rook( uplo, n, a, lda, afac, lda, iwork,
474 $ ainv, lda, rwork, result( 1 ) )
483 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
484 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
485 srnamt =
'CHETRI_ROOK'
492 $
CALL alaerh( path,
'CHETRI_ROOK', info, -1,
493 $ uplo, n, n, -1, -1, -1, imat,
494 $ nfail, nerrs, nout )
499 CALL cpot03( uplo, n, a, lda, ainv, lda, work, lda,
500 $ rwork, rcondc, result( 2 ) )
508 IF( result( k ).GE.thresh )
THEN
509 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
510 $
CALL alahd( nout, path )
511 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
524 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) ) /
527 IF( iuplo.EQ.1 )
THEN
536 IF( iwork( k ).GT.zero )
THEN
541 stemp = clange(
'M', k-1, 1,
542 $ afac( ( k-1 )*lda+1 ), lda, rwork )
548 stemp = clange(
'M', k-2, 2,
549 $ afac( ( k-2 )*lda+1 ), lda, rwork )
556 stemp = stemp - const + thresh
557 IF( stemp.GT.result( 3 ) )
558 $ result( 3 ) = stemp
574 IF( iwork( k ).GT.zero )
THEN
579 stemp = clange(
'M', n-k, 1,
580 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
586 stemp = clange(
'M', n-k-1, 2,
587 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
594 stemp = stemp - const + thresh
595 IF( stemp.GT.result( 3 ) )
596 $ result( 3 ) = stemp
612 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
613 $ ( ( one + alpha ) / ( one - alpha ) )
614 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
616 IF( iuplo.EQ.1 )
THEN
625 IF( iwork( k ).LT.zero )
THEN
631 block( 1, 1 ) = afac( ( k-2 )*lda+k-1 )
632 block( 1, 2 ) = afac( (k-1)*lda+k-1 )
633 block( 2, 1 ) = conjg( block( 1, 2 ) )
634 block( 2, 2 ) = afac( (k-1)*lda+k )
636 CALL cgesvd(
'N',
'N', 2, 2, block, 2, rwork,
637 $ cdummy, 1, cdummy, 1,
638 $ work, 6, rwork( 3 ), info )
641 sing_max = rwork( 1 )
642 sing_min = rwork( 2 )
644 stemp = sing_max / sing_min
648 stemp = stemp - const + thresh
649 IF( stemp.GT.result( 4 ) )
650 $ result( 4 ) = stemp
669 IF( iwork( k ).LT.zero )
THEN
675 block( 1, 1 ) = afac( ( k-1 )*lda+k )
676 block( 2, 1 ) = afac( ( k-1 )*lda+k+1 )
677 block( 1, 2 ) = conjg( block( 2, 1 ) )
678 block( 2, 2 ) = afac( k*lda+k+1 )
680 CALL cgesvd(
'N',
'N', 2, 2, block, 2, rwork,
681 $ cdummy, 1, cdummy, 1,
682 $ work, 6, rwork(3), info )
684 sing_max = rwork( 1 )
685 sing_min = rwork( 2 )
687 stemp = sing_max / sing_min
691 stemp = 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 )