168 SUBROUTINE cchkhe_aa( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
169 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
170 $ X, XACT, WORK, RWORK, IWORK, NOUT )
180 INTEGER NMAX, NN, NNB, NNS, NOUT
185 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
187 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
188 $ work( * ), x( * ), xact( * )
195 PARAMETER ( ZERO = 0.0e+0 )
197 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
199 parameter( ntypes = 10 )
201 parameter( ntests = 9 )
205 CHARACTER DIST,
TYPE, UPLO, XTYPE
206 CHARACTER*3 PATH, MATPATH
207 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
208 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
209 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
214 INTEGER ISEED( 4 ), ISEEDY( 4 )
215 REAL RESULT( NTESTS )
231 COMMON / infoc / infot, nunit, ok, lerr
232 COMMON / srnamc / srnamt
235 DATA iseedy / 1988, 1989, 1990, 1991 /
236 DATA uplos /
'U',
'L' /
245 path( 1: 1 ) =
'Complex precision'
250 matpath( 1: 1 ) =
'Complex precision'
251 matpath( 2: 3 ) =
'HE'
256 iseed( i ) = iseedy( i )
262 $
CALL cerrhe( path, nout )
274 IF( n .GT. nmax )
THEN
276 WRITE(nout, 9995)
'M ', n, nmax
286 DO 170 imat = 1, nimat
290 IF( .NOT.dotype( imat ) )
295 zerot = imat.GE.3 .AND. imat.LE.6
296 IF( zerot .AND. n.LT.imat-2 )
302 uplo = uplos( iuplo )
307 CALL clatb4( matpath, imat, n, n,
TYPE, kl, ku,
308 $ anorm, mode, cndnum, dist )
313 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
314 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
320 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
321 $ -1, -1, imat, nfail, nerrs, nout )
334 ELSE IF( imat.EQ.4 )
THEN
344 IF( iuplo.EQ.1 )
THEN
345 ioff = ( izero-1 )*lda
346 DO 20 i = 1, izero - 1
356 DO 40 i = 1, izero - 1
366 IF( iuplo.EQ.1 )
THEN
402 CALL claipd( n, a, lda+1, 0 )
418 CALL clacpy( uplo, n, n, a, lda, afac, lda )
425 lwork = max( 1, ( nb+1 )*lda )
427 CALL chetrf_aa( uplo, n, afac, lda, iwork, ainv,
453 CALL alaerh( path,
'CHETRF_AA', info, k, uplo,
454 $ n, n, -1, -1, nb, imat, nfail, nerrs,
461 CALL chet01_aa( uplo, n, a, lda, afac, lda, iwork,
462 $ ainv, lda, rwork, result( 1 ) )
470 IF( result( k ).GE.thresh )
THEN
471 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
472 $
CALL alahd( nout, path )
473 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
498 CALL clarhs( matpath, xtype, uplo,
' ', n, n,
499 $ kl, ku, nrhs, a, lda, xact, lda,
500 $ b, lda, iseed, info )
501 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
504 lwork = max( 1, 3*n-2 )
505 CALL chetrs_aa( uplo, n, nrhs, afac, lda, iwork,
506 $ x, lda, work, lwork, info )
511 IF( izero.EQ.0 )
THEN
512 CALL alaerh( path,
'CHETRS_AA', info, 0,
513 $ uplo, n, n, -1, -1, nrhs, imat,
514 $ nfail, nerrs, nout )
517 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda
522 CALL cpot02( uplo, n, nrhs, a, lda, x, lda,
523 $ work, lda, rwork, result( 2 ) )
529 IF( result( k ).GE.thresh )
THEN
530 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
531 $
CALL alahd( nout, path )
532 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
533 $ imat, k, result( k )
551 CALL alasum( path, nout, nfail, nrun, nerrs )
553 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
554 $ i2,
', test ', i2,
', ratio =', g12.5 )
555 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
556 $ i2,
', test(', i2,
') =', g12.5 )
557 9995
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',