442 parameter ( zero = ( 0.0, 0.0 ) )
444 parameter ( rzero = 0.0 )
447 INTEGER nalf, nbet, nidim, nmax, nout, ntra, iorder
448 LOGICAL fatal, rewi, trace
451 COMPLEX a( nmax, nmax ), aa( nmax*nmax ), alf( nalf ),
452 $ as( nmax*nmax ), b( nmax, nmax ),
453 $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
454 $ c( nmax, nmax ), cc( nmax*nmax ),
455 $ cs( nmax*nmax ), ct( nmax )
457 INTEGER idim( nidim )
459 COMPLEX alpha, als, beta, bls
461 INTEGER i, ia, ib, ica, icb, ik, im, in, k, ks, laa,
462 $ lbb, lcc, lda, ldas, ldb, ldbs, ldc, ldcs, m,
463 $ ma, mb, ms, n, na, nargs, nb, nc, ns
464 LOGICAL null, reset, same, trana, tranb
465 CHARACTER*1 tranas, tranbs, transa, transb
480 COMMON /infoc/infot, noutc, ok, lerr
503 null = n.LE.0.OR.m.LE.0
509 transa = ich( ica: ica )
510 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
530 CALL cmake(
'ge',
' ',
' ', ma, na, a, nmax, aa, lda,
534 transb = ich( icb: icb )
535 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
555 CALL cmake(
'ge',
' ',
' ', mb, nb, b, nmax, bb,
566 CALL cmake(
'ge',
' ',
' ', m, n, c, nmax,
567 $ cc, ldc, reset, zero )
597 $
CALL cprcn1(ntra, nc, sname, iorder,
598 $ transa, transb, m, n, k, alpha, lda,
602 CALL ccgemm( iorder, transa, transb, m, n,
603 $ k, alpha, aa, lda, bb, ldb,
609 WRITE( nout, fmt = 9994 )
616 isame( 1 ) = transa.EQ.tranas
617 isame( 2 ) = transb.EQ.tranbs
621 isame( 6 ) = als.EQ.alpha
622 isame( 7 ) =
lce( as, aa, laa )
623 isame( 8 ) = ldas.EQ.lda
624 isame( 9 ) =
lce( bs, bb, lbb )
625 isame( 10 ) = ldbs.EQ.ldb
626 isame( 11 ) = bls.EQ.beta
628 isame( 12 ) =
lce( cs, cc, lcc )
630 isame( 12 ) =
lceres(
'ge',
' ', m, n, cs,
633 isame( 13 ) = ldcs.EQ.ldc
640 same = same.AND.isame( i )
641 IF( .NOT.isame( i ) )
642 $
WRITE( nout, fmt = 9998 )i
653 CALL cmmch( transa, transb, m, n, k,
654 $ alpha, a, nmax, b, nmax, beta,
655 $ c, nmax, ct, g, cc, ldc, eps,
656 $ err, fatal, nout, .true. )
657 errmax = max( errmax, err )
680 IF( errmax.LT.thresh )
THEN
681 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
682 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
684 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
685 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
690 WRITE( nout, fmt = 9996 )sname
691 CALL cprcn1(nout, nc, sname, iorder, transa, transb,
692 $ m, n, k, alpha, lda, ldb, beta, ldc)
697 10003
FORMAT(
' ', a12,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
698 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
699 $
'RATIO ', f8.2,
' - SUSPECT *******' )
700 10002
FORMAT(
' ', a12,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
701 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
702 $
'RATIO ', f8.2,
' - SUSPECT *******' )
703 10001
FORMAT(
' ', a12,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
704 $
' (', i6,
' CALL',
'S)' )
705 10000
FORMAT(
' ', a12,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
706 $
' (', i6,
' CALL',
'S)' )
707 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
708 $
'ANGED INCORRECTLY *******' )
709 9996
FORMAT(
' ******* ', a12,
' FAILED ON CALL NUMBER:' )
710 9995
FORMAT( 1x, i6,
': ', a12,
'(''', a1,
''',''', a1,
''',',
711 $ 3( i3,
',' ),
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
712 $
',(', f4.1,
',', f4.1,
'), C,', i3,
').' )
713 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
subroutine cmmch(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, NOUT, MV)
subroutine cprcn1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB, BETA, LDC)
logical function lce(RI, RJ, LR)
subroutine cmake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
logical function lceres(TYPE, UPLO, M, N, AA, AS, LDA)