407 DOUBLE PRECISION ZERO
408 parameter( zero = 0.0d0 )
410 DOUBLE PRECISION EPS, THRESH
411 INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
412 LOGICAL FATAL, REWI, TRACE
415 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
416 $ AS( NMAX*NMAX ), B( NMAX, NMAX ),
417 $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
418 $ C( NMAX, NMAX ), CC( NMAX*NMAX ),
419 $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
420 INTEGER IDIM( NIDIM )
422 DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX
423 INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
424 $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
425 $ MA, MB, MS, N, NA, NARGS, NB, NC, NS
426 LOGICAL NULL, RESET, SAME, TRANA, TRANB
427 CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB
442 COMMON /infoc/infot, noutc, ok, lerr
465 null = n.LE.0.OR.m.LE.0
471 transa = ich( ica: ica )
472 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
492 CALL dmake(
'GE',
' ',
' ', ma, na, a, nmax, aa, lda,
496 transb = ich( icb: icb )
497 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
517 CALL dmake(
'GE',
' ',
' ', mb, nb, b, nmax, bb,
528 CALL dmake(
'GE',
' ',
' ', m, n, c, nmax,
529 $ cc, ldc, reset, zero )
559 $
WRITE( ntra, fmt = 9995 )nc, sname,
560 $ transa, transb, m, n, k, alpha, lda, ldb,
564 CALL dgemm( transa, transb, m, n, k, alpha,
565 $ aa, lda, bb, ldb, beta, cc, ldc )
570 WRITE( nout, fmt = 9994 )
577 isame( 1 ) = transa.EQ.tranas
578 isame( 2 ) = transb.EQ.tranbs
582 isame( 6 ) = als.EQ.alpha
583 isame( 7 ) =
lde( as, aa, laa )
584 isame( 8 ) = ldas.EQ.lda
585 isame( 9 ) =
lde( bs, bb, lbb )
586 isame( 10 ) = ldbs.EQ.ldb
587 isame( 11 ) = bls.EQ.beta
589 isame( 12 ) =
lde( cs, cc, lcc )
591 isame( 12 ) =
lderes(
'GE',
' ', m, n, cs,
594 isame( 13 ) = ldcs.EQ.ldc
601 same = same.AND.isame( i )
602 IF( .NOT.isame( i ) )
603 $
WRITE( nout, fmt = 9998 )i
614 CALL dmmch( transa, transb, m, n, k,
615 $ alpha, a, nmax, b, nmax, beta,
616 $ c, nmax, ct, g, cc, ldc, eps,
617 $ err, fatal, nout, .true. )
618 errmax = max( errmax, err )
641 IF( errmax.LT.thresh )
THEN
642 WRITE( nout, fmt = 9999 )sname, nc
644 WRITE( nout, fmt = 9997 )sname, nc, errmax
649 WRITE( nout, fmt = 9996 )sname
650 WRITE( nout, fmt = 9995 )nc, sname, transa, transb, m, n, k,
651 $ alpha, lda, ldb, beta, ldc
656 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
658 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
659 $
'ANGED INCORRECTLY *******' )
660 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
661 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
662 $
' - SUSPECT *******' )
663 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
664 9995
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',''', a1,
''',',
665 $ 3( i3,
',' ), f4.1,
', A,', i3,
', B,', i3,
',', f4.1,
', ',
667 9994
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 dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM