470 DOUBLE PRECISION zero, half
471 parameter ( zero = 0.0d0, half = 0.5d0 )
473 DOUBLE PRECISION eps, thresh
474 INTEGER incmax, nalf, nbet, nidim, ninc, nkb, nmax,
476 LOGICAL fatal, rewi, trace
479 DOUBLE PRECISION a( nmax, nmax ), aa( nmax*nmax ), alf( nalf ),
480 $ as( nmax*nmax ), bet( nbet ), g( nmax ),
481 $ x( nmax ), xs( nmax*incmax ),
482 $ xx( nmax*incmax ), y( nmax ),
483 $ ys( nmax*incmax ), yt( nmax ),
485 INTEGER idim( nidim ), inc( ninc ), kb( nkb )
487 DOUBLE PRECISION alpha, als, beta, bls, err, errmax, transl
488 INTEGER i, ia, ib, ic, iku, im, in, incx, incxs, incy,
489 $ incys, ix, iy, kl, kls, ku, kus, laa, lda,
490 $ ldas, lx, ly, m, ml, ms, n, nargs, nc, nd, nk,
492 LOGICAL banded, full, null, reset, same, tran
493 CHARACTER*1 trans, transs
504 INTRINSIC abs, max, min
509 COMMON /infoc/infot, noutc, ok
513 full = sname( 9: 9 ).EQ.
'e'
514 banded = sname( 9: 9 ).EQ.
'b'
518 ELSE IF( banded )
THEN
532 $ m = max( n - nd, 0 )
534 $ m = min( n + nd, nmax )
544 kl = max( ku - 1, 0 )
561 null = n.LE.0.OR.m.LE.0
566 CALL dmake( sname( 8: 9 ),
' ',
' ', m, n, a, nmax, aa,
567 $ lda, kl, ku, reset, transl )
570 trans = ich( ic: ic )
571 IF (trans.EQ.
'N')
THEN
572 ctrans =
' CblasNoTrans'
573 ELSE IF (trans.EQ.
'T')
THEN
574 ctrans =
' CblasTrans'
576 ctrans =
'CblasConjTrans'
578 tran = trans.EQ.
'T'.OR.trans.EQ.
'C'
595 CALL dmake(
'ge',
' ',
' ', 1, nl, x, 1, xx,
596 $ abs( incx ), 0, nl - 1, reset, transl )
599 xx( 1 + abs( incx )*( nl/2 - 1 ) ) = zero
615 CALL dmake(
'ge',
' ',
' ', 1, ml, y, 1,
616 $ yy, abs( incy ), 0, ml - 1,
648 $
WRITE( ntra, fmt = 9994 )nc, sname,
649 $ ctrans, m, n, alpha, lda, incx,
653 CALL cdgemv( iorder, trans, m, n,
654 $ alpha, aa, lda, xx, incx,
656 ELSE IF( banded )
THEN
658 $
WRITE( ntra, fmt = 9995 )nc, sname,
659 $ ctrans, m, n, kl, ku, alpha, lda,
663 CALL cdgbmv( iorder, trans, m, n, kl,
664 $ ku, alpha, aa, lda, xx,
665 $ incx, beta, yy, incy )
671 WRITE( nout, fmt = 9993 )
678 isame( 1 ) = trans.EQ.transs
682 isame( 4 ) = als.EQ.alpha
683 isame( 5 ) =
lde( as, aa, laa )
684 isame( 6 ) = ldas.EQ.lda
685 isame( 7 ) =
lde( xs, xx, lx )
686 isame( 8 ) = incxs.EQ.incx
687 isame( 9 ) = bls.EQ.beta
689 isame( 10 ) =
lde( ys, yy, ly )
691 isame( 10 ) =
lderes(
'ge',
' ', 1,
695 isame( 11 ) = incys.EQ.incy
696 ELSE IF( banded )
THEN
697 isame( 4 ) = kls.EQ.kl
698 isame( 5 ) = kus.EQ.ku
699 isame( 6 ) = als.EQ.alpha
700 isame( 7 ) =
lde( as, aa, laa )
701 isame( 8 ) = ldas.EQ.lda
702 isame( 9 ) =
lde( xs, xx, lx )
703 isame( 10 ) = incxs.EQ.incx
704 isame( 11 ) = bls.EQ.beta
706 isame( 12 ) =
lde( ys, yy, ly )
708 isame( 12 ) =
lderes(
'ge',
' ', 1,
712 isame( 13 ) = incys.EQ.incy
720 same = same.AND.isame( i )
721 IF( .NOT.isame( i ) )
722 $
WRITE( nout, fmt = 9998 )i
733 CALL dmvch( trans, m, n, alpha, a,
734 $ nmax, x, incx, beta, y,
735 $ incy, yt, g, yy, eps, err,
736 $ fatal, nout, .true. )
737 errmax = max( errmax, err )
766 IF( errmax.LT.thresh )
THEN
767 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
768 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
770 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
771 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
776 WRITE( nout, fmt = 9996 )sname
778 WRITE( nout, fmt = 9994 )nc, sname, ctrans, m, n, alpha, lda,
780 ELSE IF( banded )
THEN
781 WRITE( nout, fmt = 9995 )nc, sname, ctrans, m, n, kl, ku,
782 $ alpha, lda, incx, beta, incy
788 10003
FORMAT(
' ', a12,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
789 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
790 $
'RATIO ', f8.2,
' - SUSPECT *******' )
791 10002
FORMAT(
' ', a12,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
792 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
793 $
'RATIO ', f8.2,
' - SUSPECT *******' )
794 10001
FORMAT(
' ', a12,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
795 $
' (', i6,
' CALL',
'S)' )
796 10000
FORMAT(
' ', a12,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
797 $
' (', i6,
' CALL',
'S)' )
798 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
799 $
'ANGED INCORRECTLY *******' )
800 9997
FORMAT(
' ',a12,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
801 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
802 $
' - SUSPECT *******' )
803 9996
FORMAT(
' ******* ',a12,
' FAILED ON CALL NUMBER:' )
804 9995
FORMAT( 1x, i6,
': ',a12,
'(', a14,
',', 4( i3,
',' ), f4.1,
805 $
', A,', i3,
',',/ 10x,
'X,', i2,
',', f4.1,
', Y,',
807 9994
FORMAT( 1x, i6,
': ',a12,
'(', a14,
',', 2( i3,
',' ), f4.1,
808 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
810 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)
subroutine dmvch(TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV)
logical function lderes(TYPE, UPLO, M, N, AA, AS, LDA)