1263 DOUBLE PRECISION ZERO
1264 parameter( zero = 0.0d0 )
1266 DOUBLE PRECISION EPS, THRESH
1267 INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
1268 LOGICAL FATAL, REWI, TRACE
1271 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
1272 $ AS( NMAX*NMAX ), B( NMAX, NMAX ),
1273 $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
1274 $ C( NMAX, NMAX ), CC( NMAX*NMAX ),
1275 $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
1276 INTEGER IDIM( NIDIM )
1278 DOUBLE PRECISION ALPHA, ALS, BETA, BETS, ERR, ERRMAX
1279 INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
1280 $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
1282 LOGICAL NULL, RESET, SAME, TRAN, UPPER
1283 CHARACTER*1 TRANS, TRANSS, UPLO, UPLOS
1296 INTEGER INFOT, NOUTC
1299 COMMON /infoc/infot, noutc, ok, lerr
1301 DATA icht/
'NTC'/, ichu/
'UL'/
1309 DO 100 in = 1, nidim
1325 trans = icht( ict: ict )
1326 tran = trans.EQ.
'T'.OR.trans.EQ.
'C'
1345 CALL dmake(
'GE',
' ',
' ', ma, na, a, nmax, aa, lda,
1349 uplo = ichu( icu: icu )
1360 CALL dmake(
'SY', uplo,
' ', n, n, c, nmax, cc,
1361 $ ldc, reset, zero )
1385 $
WRITE( ntra, fmt = 9994 )nc, sname, uplo,
1386 $ trans, n, k, alpha, lda, beta, ldc
1389 CALL dsyrk( uplo, trans, n, k, alpha, aa, lda,
1395 WRITE( nout, fmt = 9993 )
1402 isame( 1 ) = uplos.EQ.uplo
1403 isame( 2 ) = transs.EQ.trans
1404 isame( 3 ) = ns.EQ.n
1405 isame( 4 ) = ks.EQ.k
1406 isame( 5 ) = als.EQ.alpha
1407 isame( 6 ) =
lde( as, aa, laa )
1408 isame( 7 ) = ldas.EQ.lda
1409 isame( 8 ) = bets.EQ.beta
1411 isame( 9 ) =
lde( cs, cc, lcc )
1413 isame( 9 ) =
lderes(
'SY', uplo, n, n, cs,
1416 isame( 10 ) = ldcs.EQ.ldc
1423 same = same.AND.isame( i )
1424 IF( .NOT.isame( i ) )
1425 $
WRITE( nout, fmt = 9998 )i
1446 CALL dmmch(
'T',
'N', lj, 1, k, alpha,
1448 $ a( 1, j ), nmax, beta,
1449 $ c( jj, j ), nmax, ct, g,
1450 $ cc( jc ), ldc, eps, err,
1451 $ fatal, nout, .true. )
1453 CALL dmmch(
'N',
'T', lj, 1, k, alpha,
1455 $ a( j, 1 ), nmax, beta,
1456 $ c( jj, j ), nmax, ct, g,
1457 $ cc( jc ), ldc, eps, err,
1458 $ fatal, nout, .true. )
1465 errmax = max( errmax, err )
1487 IF( errmax.LT.thresh )
THEN
1488 WRITE( nout, fmt = 9999 )sname, nc
1490 WRITE( nout, fmt = 9997 )sname, nc, errmax
1496 $
WRITE( nout, fmt = 9995 )j
1499 WRITE( nout, fmt = 9996 )sname
1500 WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, n, k, alpha,
1506 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1508 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1509 $
'ANGED INCORRECTLY *******' )
1510 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1511 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1512 $
' - SUSPECT *******' )
1513 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1514 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1515 9994
FORMAT( 1x, i6,
': ', a6,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1516 $ f4.1,
', A,', i3,
',', f4.1,
', C,', i3,
') .' )
1517 9993
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
subroutine dmake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
logical function lde(RI, RJ, LR)
logical function lderes(TYPE, UPLO, M, N, AA, AS, LDA)
subroutine dmmch(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, NOUT, MV)
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK