170 SUBROUTINE cchksy( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
171 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
172 $ XACT, WORK, RWORK, IWORK, NOUT )
181 INTEGER nmax, nn, nnb, nns, nout
186 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
188 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
189 $ work( * ), x( * ), xact( * )
196 PARAMETER ( ZERO = 0.0e+0 )
198 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
200 parameter( ntypes = 11 )
202 parameter( ntests = 9 )
205 LOGICAL TRFCON, ZEROT
206 CHARACTER DIST,
TYPE, UPLO, XTYPE
208 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
209 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
210 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211 REAL ANORM, CNDNUM, RCOND, RCONDC
215 INTEGER ISEED( 4 ), ISEEDY( 4 )
216 REAL RESULT( NTESTS )
220 EXTERNAL SGET06, CLANSY
237 COMMON / infoc / infot, nunit, ok, lerr
238 COMMON / srnamc / srnamt
241 DATA iseedy / 1988, 1989, 1990, 1991 /
242 DATA uplos /
'U',
'L' /
248 path( 1: 1 ) =
'Complex precision'
254 iseed( i ) = iseedy( i )
260 $
CALL cerrsy( path, nout )
282 DO 170 imat = 1, nimat
286 IF( .NOT.dotype( imat ) )
291 zerot = imat.GE.3 .AND. imat.LE.6
292 IF( zerot .AND. n.LT.imat-2 )
298 uplo = uplos( iuplo )
302 IF( imat.NE.ntypes )
THEN
307 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm,
308 $ mode, cndnum, dist )
313 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
314 $ cndnum, anorm, kl, ku,
'N', a, lda, work,
320 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
321 $ -1, -1, -1, imat, nfail, nerrs, nout )
335 ELSE IF( imat.EQ.4 )
THEN
345 IF( iuplo.EQ.1 )
THEN
346 ioff = ( izero-1 )*lda
347 DO 20 i = 1, izero - 1
357 DO 40 i = 1, izero - 1
367 IF( iuplo.EQ.1 )
THEN
403 CALL clatsy( uplo, n, a, lda, iseed )
424 CALL clacpy( uplo, n, n, a, lda, afac, lda )
431 lwork = max( 2, nb )*lda
433 CALL csytrf( uplo, n, afac, lda, iwork, ainv, lwork,
442 IF( iwork( k ).LT.0 )
THEN
443 IF( iwork( k ).NE.-k )
THEN
447 ELSE IF( iwork( k ).NE.k )
THEN
456 $
CALL alaerh( path,
'CSYTRF', info, k, uplo, n, n,
457 $ -1, -1, nb, imat, nfail, nerrs, nout )
470 CALL csyt01( uplo, n, a, lda, afac, lda, iwork, ainv,
471 $ lda, rwork, result( 1 ) )
480 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
481 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
483 lwork = (n+nb+1)*(nb+3)
484 CALL csytri2( uplo, n, ainv, lda, iwork, work,
490 $
CALL alaerh( path,
'CSYTRI2', info, 0, uplo, n,
491 $ n, -1, -1, -1, imat, nfail, nerrs,
497 CALL csyt03( uplo, n, a, lda, ainv, lda, work, lda,
498 $ rwork, rcondc, result( 2 ) )
506 IF( result( k ).GE.thresh )
THEN
507 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
508 $
CALL alahd( nout, path )
509 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
541 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
542 $ nrhs, a, lda, xact, lda, b, lda,
544 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
547 CALL csytrs( uplo, n, nrhs, afac, lda, iwork, x,
553 $
CALL alaerh( path,
'CSYTRS', info, 0, uplo, n,
554 $ n, -1, -1, nrhs, imat, nfail,
557 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
561 CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
562 $ lda, rwork, result( 3 ) )
571 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
572 $ nrhs, a, lda, xact, lda, b, lda,
574 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
577 CALL csytrs2( uplo, n, nrhs, afac, lda, iwork, x,
583 $
CALL alaerh( path,
'CSYTRS2', info, 0, uplo, n,
584 $ n, -1, -1, nrhs, imat, nfail,
587 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
591 CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
592 $ lda, rwork, result( 4 ) )
597 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
604 CALL csyrfs( uplo, n, nrhs, a, lda, afac, lda,
605 $ iwork, b, lda, x, lda, rwork,
606 $ rwork( nrhs+1 ), work,
607 $ rwork( 2*nrhs+1 ), info )
612 $
CALL alaerh( path,
'CSYRFS', info, 0, uplo, n,
613 $ n, -1, -1, nrhs, imat, nfail,
616 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
618 CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
619 $ xact, lda, rwork, rwork( nrhs+1 ),
626 IF( result( k ).GE.thresh )
THEN
627 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
628 $
CALL alahd( nout, path )
629 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
630 $ imat, k, result( k )
644 anorm = clansy(
'1', uplo, n, a, lda, rwork )
646 CALL csycon( uplo, n, afac, lda, iwork, anorm, rcond,
652 $
CALL alaerh( path,
'CSYCON', info, 0, uplo, n, n,
653 $ -1, -1, -1, imat, nfail, nerrs, nout )
657 result( 9 ) = sget06( rcond, rcondc )
662 IF( result( 9 ).GE.thresh )
THEN
663 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
664 $
CALL alahd( nout, path )
665 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
677 CALL alasum( path, nout, nfail, nrun, nerrs )
679 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
680 $ i2,
', test ', i2,
', ratio =', g12.5 )
681 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
682 $ i2,
', test(', i2,
') =', g12.5 )
683 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
684 $
', test(', i2,
') =', g12.5 )