786 parameter ( zero = 0.0, half = 0.5 )
789 INTEGER incmax, nalf, nbet, nidim, ninc, nkb, nmax,
791 LOGICAL fatal, rewi, trace
794 REAL a( nmax, nmax ), aa( nmax*nmax ), alf( nalf ),
795 $ as( nmax*nmax ), bet( nbet ), g( nmax ),
796 $ x( nmax ), xs( nmax*incmax ),
797 $ xx( nmax*incmax ), y( nmax ),
798 $ ys( nmax*incmax ), yt( nmax ),
800 INTEGER idim( nidim ), inc( ninc ), kb( nkb )
802 REAL alpha, als, beta, bls, err, errmax, transl
803 INTEGER i, ia, ib, ic, ik, in, incx, incxs, incy,
804 $ incys, ix, iy, k, ks, laa, lda, ldas, lx, ly,
805 $ n, nargs, nc, nk, ns
806 LOGICAL banded, full, null, packed, reset, same
807 CHARACTER*1 uplo, uplos
822 COMMON /infoc/infot, noutc, ok, lerr
826 full = sname( 3: 3 ).EQ.
'Y'
827 banded = sname( 3: 3 ).EQ.
'B'
828 packed = sname( 3: 3 ).EQ.
'P'
832 ELSE IF( banded )
THEN
834 ELSE IF( packed )
THEN
868 laa = ( n*( n + 1 ) )/2
880 CALL smake( sname( 2: 3 ), uplo,
' ', n, n, a, nmax, aa,
881 $ lda, k, k, reset, transl )
890 CALL smake(
'GE',
' ',
' ', 1, n, x, 1, xx,
891 $ abs( incx ), 0, n - 1, reset, transl )
894 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
910 CALL smake(
'GE',
' ',
' ', 1, n, y, 1, yy,
911 $ abs( incy ), 0, n - 1, reset,
941 $
WRITE( ntra, fmt = 9993 )nc, sname,
942 $ uplo, n, alpha, lda, incx, beta, incy
945 CALL ssymv( uplo, n, alpha, aa, lda, xx,
946 $ incx, beta, yy, incy )
947 ELSE IF( banded )
THEN
949 $
WRITE( ntra, fmt = 9994 )nc, sname,
950 $ uplo, n, k, alpha, lda, incx, beta,
954 CALL ssbmv( uplo, n, k, alpha, aa, lda,
955 $ xx, incx, beta, yy, incy )
956 ELSE IF( packed )
THEN
958 $
WRITE( ntra, fmt = 9995 )nc, sname,
959 $ uplo, n, alpha, incx, beta, incy
962 CALL sspmv( uplo, n, alpha, aa, xx, incx,
969 WRITE( nout, fmt = 9992 )
976 isame( 1 ) = uplo.EQ.uplos
979 isame( 3 ) = als.EQ.alpha
980 isame( 4 ) =
lse( as, aa, laa )
981 isame( 5 ) = ldas.EQ.lda
982 isame( 6 ) =
lse( xs, xx, lx )
983 isame( 7 ) = incxs.EQ.incx
984 isame( 8 ) = bls.EQ.beta
986 isame( 9 ) =
lse( ys, yy, ly )
988 isame( 9 ) =
lseres(
'GE',
' ', 1, n,
989 $ ys, yy, abs( incy ) )
991 isame( 10 ) = incys.EQ.incy
992 ELSE IF( banded )
THEN
994 isame( 4 ) = als.EQ.alpha
995 isame( 5 ) =
lse( as, aa, laa )
996 isame( 6 ) = ldas.EQ.lda
997 isame( 7 ) =
lse( xs, xx, lx )
998 isame( 8 ) = incxs.EQ.incx
999 isame( 9 ) = bls.EQ.beta
1001 isame( 10 ) =
lse( ys, yy, ly )
1003 isame( 10 ) =
lseres(
'GE',
' ', 1, n,
1004 $ ys, yy, abs( incy ) )
1006 isame( 11 ) = incys.EQ.incy
1007 ELSE IF( packed )
THEN
1008 isame( 3 ) = als.EQ.alpha
1009 isame( 4 ) =
lse( as, aa, laa )
1010 isame( 5 ) =
lse( xs, xx, lx )
1011 isame( 6 ) = incxs.EQ.incx
1012 isame( 7 ) = bls.EQ.beta
1014 isame( 8 ) =
lse( ys, yy, ly )
1016 isame( 8 ) =
lseres(
'GE',
' ', 1, n,
1017 $ ys, yy, abs( incy ) )
1019 isame( 9 ) = incys.EQ.incy
1027 same = same.AND.isame( i )
1028 IF( .NOT.isame( i ) )
1029 $
WRITE( nout, fmt = 9998 )i
1040 CALL smvch(
'N', n, n, alpha, a, nmax, x,
1041 $ incx, beta, y, incy, yt, g,
1042 $ yy, eps, err, fatal, nout,
1044 errmax = max( errmax, err )
1070 IF( errmax.LT.thresh )
THEN
1071 WRITE( nout, fmt = 9999 )sname, nc
1073 WRITE( nout, fmt = 9997 )sname, nc, errmax
1078 WRITE( nout, fmt = 9996 )sname
1080 WRITE( nout, fmt = 9993 )nc, sname, uplo, n, alpha, lda, incx,
1082 ELSE IF( banded )
THEN
1083 WRITE( nout, fmt = 9994 )nc, sname, uplo, n, k, alpha, lda,
1085 ELSE IF( packed )
THEN
1086 WRITE( nout, fmt = 9995 )nc, sname, uplo, n, alpha, incx,
1093 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1095 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1096 $
'ANGED INCORRECTLY *******' )
1097 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1098 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1099 $
' - SUSPECT *******' )
1100 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1101 9995
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', AP',
1102 $
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
1103 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', 2( i3,
',' ), f4.1,
1104 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
1106 9993
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', A,',
1107 $ i3,
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
1108 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
subroutine ssbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSBMV
subroutine smake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
subroutine smvch(TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV)
logical function lse(RI, RJ, LR)
logical function lseres(TYPE, UPLO, M, N, AA, AS, LDA)
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV