114 parameter ( nin = 5 )
116 parameter ( nsubs = 16 )
118 parameter ( zero = 0.0, one = 1.0 )
120 parameter ( nmax = 65, incmax = 2 )
121 INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
122 parameter ( ninmax = 7, nidmax = 9, nkbmax = 7,
123 $ nalmax = 7, nbemax = 7 )
125 REAL EPS, ERR, THRESH
126 INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB,
128 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
132 CHARACTER*32 SNAPS, SUMMRY
134 REAL A( nmax, nmax ), AA( nmax*nmax ),
135 $ alf( nalmax ), as( nmax*nmax ), bet( nbemax ),
136 $ g( nmax ), x( nmax ), xs( nmax*incmax ),
137 $ xx( nmax*incmax ), y( nmax ),
138 $ ys( nmax*incmax ), yt( nmax ),
139 $ yy( nmax*incmax ), z( 2*nmax )
140 INTEGER IDIM( nidmax ), INC( ninmax ), KB( nkbmax )
141 LOGICAL LTEST( nsubs )
142 CHARACTER*6 SNAMES( nsubs )
151 INTRINSIC abs, max, min
157 COMMON /infoc/infot, noutc, ok, lerr
158 COMMON /srnamc/srnamt
160 DATA snames/
'SGEMV ',
'SGBMV ',
'SSYMV ',
'SSBMV ',
161 $
'SSPMV ',
'STRMV ',
'STBMV ',
'STPMV ',
162 $
'STRSV ',
'STBSV ',
'STPSV ',
'SGER ',
163 $
'SSYR ',
'SSPR ',
'SSYR2 ',
'SSPR2 '/
168 READ( nin, fmt = * )summry
169 READ( nin, fmt = * )nout
170 OPEN( nout, file = summry, status =
'UNKNOWN' )
175 READ( nin, fmt = * )snaps
176 READ( nin, fmt = * )ntra
179 OPEN( ntra, file = snaps, status =
'UNKNOWN' )
182 READ( nin, fmt = * )rewi
183 rewi = rewi.AND.trace
185 READ( nin, fmt = * )sfatal
187 READ( nin, fmt = * )tsterr
189 READ( nin, fmt = * )thresh
194 READ( nin, fmt = * )nidim
195 IF( nidim.LT.1.OR.nidim.GT.nidmax )
THEN
196 WRITE( nout, fmt = 9997 )
'N', nidmax
199 READ( nin, fmt = * )( idim( i ), i = 1, nidim )
201 IF( idim( i ).LT.0.OR.idim( i ).GT.nmax )
THEN
202 WRITE( nout, fmt = 9996 )nmax
207 READ( nin, fmt = * )nkb
208 IF( nkb.LT.1.OR.nkb.GT.nkbmax )
THEN
209 WRITE( nout, fmt = 9997 )
'K', nkbmax
212 READ( nin, fmt = * )( kb( i ), i = 1, nkb )
214 IF( kb( i ).LT.0 )
THEN
215 WRITE( nout, fmt = 9995 )
220 READ( nin, fmt = * )ninc
221 IF( ninc.LT.1.OR.ninc.GT.ninmax )
THEN
222 WRITE( nout, fmt = 9997 )
'INCX AND INCY', ninmax
225 READ( nin, fmt = * )( inc( i ), i = 1, ninc )
227 IF( inc( i ).EQ.0.OR.abs( inc( i ) ).GT.incmax )
THEN
228 WRITE( nout, fmt = 9994 )incmax
233 READ( nin, fmt = * )nalf
234 IF( nalf.LT.1.OR.nalf.GT.nalmax )
THEN
235 WRITE( nout, fmt = 9997 )
'ALPHA', nalmax
238 READ( nin, fmt = * )( alf( i ), i = 1, nalf )
240 READ( nin, fmt = * )nbet
241 IF( nbet.LT.1.OR.nbet.GT.nbemax )
THEN
242 WRITE( nout, fmt = 9997 )
'BETA', nbemax
245 READ( nin, fmt = * )( bet( i ), i = 1, nbet )
249 WRITE( nout, fmt = 9993 )
250 WRITE( nout, fmt = 9992 )( idim( i ), i = 1, nidim )
251 WRITE( nout, fmt = 9991 )( kb( i ), i = 1, nkb )
252 WRITE( nout, fmt = 9990 )( inc( i ), i = 1, ninc )
253 WRITE( nout, fmt = 9989 )( alf( i ), i = 1, nalf )
254 WRITE( nout, fmt = 9988 )( bet( i ), i = 1, nbet )
255 IF( .NOT.tsterr )
THEN
256 WRITE( nout, fmt = * )
257 WRITE( nout, fmt = 9980 )
259 WRITE( nout, fmt = * )
260 WRITE( nout, fmt = 9999 )thresh
261 WRITE( nout, fmt = * )
269 50
READ( nin, fmt = 9984, end = 80 )snamet, ltestt
271 IF( snamet.EQ.snames( i ) )
274 WRITE( nout, fmt = 9986 )snamet
276 70 ltest( i ) = ltestt
285 WRITE( nout, fmt = 9998 )eps
292 a( i, j ) = max( i - j + 1, 0 )
298 yy( j ) = j*( ( j + 1 )*j )/2 - ( ( j + 1 )*j*( j - 1 ) )/3
303 CALL smvch( trans, n, n, one, a, nmax, x, 1, zero, y, 1, yt, g,
304 $ yy, eps, err, fatal, nout, .true. )
305 same = lse( yy, yt, n )
306 IF( .NOT.same.OR.err.NE.zero )
THEN
307 WRITE( nout, fmt = 9985 )trans, same, err
311 CALL smvch( trans, n, n, one, a, nmax, x, -1, zero, y, -1, yt, g,
312 $ yy, eps, err, fatal, nout, .true. )
313 same = lse( yy, yt, n )
314 IF( .NOT.same.OR.err.NE.zero )
THEN
315 WRITE( nout, fmt = 9985 )trans, same, err
321 DO 210 isnum = 1, nsubs
322 WRITE( nout, fmt = * )
323 IF( .NOT.ltest( isnum ) )
THEN
325 WRITE( nout, fmt = 9983 )snames( isnum )
327 srnamt = snames( isnum )
330 CALL schke( isnum, snames( isnum ), nout )
331 WRITE( nout, fmt = * )
337 GO TO ( 140, 140, 150, 150, 150, 160, 160,
338 $ 160, 160, 160, 160, 170, 180, 180,
341 140
CALL schk1( snames( isnum ), eps, thresh, nout, ntra, trace,
342 $ rewi, fatal, nidim, idim, nkb, kb, nalf, alf,
343 $ nbet, bet, ninc, inc, nmax, incmax, a, aa, as,
344 $ x, xx, xs, y, yy, ys, yt, g )
347 150
CALL schk2( snames( isnum ), eps, thresh, nout, ntra, trace,
348 $ rewi, fatal, nidim, idim, nkb, kb, nalf, alf,
349 $ nbet, bet, ninc, inc, nmax, incmax, a, aa, as,
350 $ x, xx, xs, y, yy, ys, yt, g )
354 160
CALL schk3( snames( isnum ), eps, thresh, nout, ntra, trace,
355 $ rewi, fatal, nidim, idim, nkb, kb, ninc, inc,
356 $ nmax, incmax, a, aa, as, y, yy, ys, yt, g, z )
359 170
CALL schk4( snames( isnum ), eps, thresh, nout, ntra, trace,
360 $ rewi, fatal, nidim, idim, nalf, alf, ninc, inc,
361 $ nmax, incmax, a, aa, as, x, xx, xs, y, yy, ys,
365 180
CALL schk5( snames( isnum ), eps, thresh, nout, ntra, trace,
366 $ rewi, fatal, nidim, idim, nalf, alf, ninc, inc,
367 $ nmax, incmax, a, aa, as, x, xx, xs, y, yy, ys,
371 190
CALL schk6( snames( isnum ), eps, thresh, nout, ntra, trace,
372 $ rewi, fatal, nidim, idim, nalf, alf, ninc, inc,
373 $ nmax, incmax, a, aa, as, x, xx, xs, y, yy, ys,
376 200
IF( fatal.AND.sfatal )
380 WRITE( nout, fmt = 9982 )
384 WRITE( nout, fmt = 9981 )
388 WRITE( nout, fmt = 9987 )
396 9999
FORMAT(
' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
398 9998
FORMAT(
' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1p, e9.1 )
399 9997
FORMAT(
' NUMBER OF VALUES OF ', a,
' IS LESS THAN 1 OR GREATER ',
401 9996
FORMAT(
' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', i2 )
402 9995
FORMAT(
' VALUE OF K IS LESS THAN 0' )
403 9994
FORMAT(
' ABSOLUTE VALUE OF INCX OR INCY IS 0 OR GREATER THAN ',
405 9993
FORMAT(
' TESTS OF THE REAL LEVEL 2 BLAS', //
' THE F',
406 $
'OLLOWING PARAMETER VALUES WILL BE USED:' )
407 9992
FORMAT(
' FOR N ', 9i6 )
408 9991
FORMAT(
' FOR K ', 7i6 )
409 9990
FORMAT(
' FOR INCX AND INCY ', 7i6 )
410 9989
FORMAT(
' FOR ALPHA ', 7f6.1 )
411 9988
FORMAT(
' FOR BETA ', 7f6.1 )
412 9987
FORMAT(
' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
413 $ /
' ******* TESTS ABANDONED *******' )
414 9986
FORMAT(
' SUBPROGRAM NAME ', a6,
' NOT RECOGNIZED', /
' ******* T',
415 $
'ESTS ABANDONED *******' )
416 9985
FORMAT(
' ERROR IN SMVCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
417 $
'ATED WRONGLY.', /
' SMVCH WAS CALLED WITH TRANS = ', a1,
418 $
' AND RETURNED SAME = ', l1,
' AND ERR = ', f12.3,
'.', /
419 $
' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.'
420 $ , /
' ******* TESTS ABANDONED *******' )
421 9984
FORMAT( a6, l2 )
422 9983
FORMAT( 1x, a6,
' WAS NOT TESTED' )
423 9982
FORMAT( /
' END OF TESTS' )
424 9981
FORMAT( /
' ******* FATAL ERROR - TESTS ABANDONED *******' )
425 9980
FORMAT(
' ERROR-EXITS WILL NOT BE TESTED' )
430 SUBROUTINE schk1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
431 $ fatal, nidim, idim, nkb, kb, nalf, alf, nbet,
432 $ bet, ninc, inc, nmax, incmax, a, aa, as, x, xx,
433 $ xs, y, yy, ys, yt, g )
445 parameter ( zero = 0.0, half = 0.5 )
448 INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
450 LOGICAL FATAL, REWI, TRACE
453 REAL A( nmax, nmax ), AA( nmax*nmax ), ALF( nalf ),
454 $ as( nmax*nmax ), bet( nbet ), g( nmax ),
455 $ x( nmax ), xs( nmax*incmax ),
456 $ xx( nmax*incmax ), y( nmax ),
457 $ ys( nmax*incmax ), yt( nmax ),
459 INTEGER IDIM( nidim ), INC( ninc ), KB( nkb )
461 REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL
462 INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY,
463 $ incys, ix, iy, kl, kls, ku, kus, laa, lda,
464 $ ldas, lx, ly, m, ml, ms, n, nargs, nc, nd, nk,
466 LOGICAL BANDED, FULL, NULL, RESET, SAME, TRAN
467 CHARACTER*1 TRANS, TRANSS
477 INTRINSIC abs, max, min
482 COMMON /infoc/infot, noutc, ok, lerr
486 full = sname( 3: 3 ).EQ.
'E'
487 banded = sname( 3: 3 ).EQ.
'B'
491 ELSE IF( banded )
THEN
505 $ m = max( n - nd, 0 )
507 $ m = min( n + nd, nmax )
517 kl = max( ku - 1, 0 )
534 null = n.LE.0.OR.m.LE.0
539 CALL smake( sname( 2: 3 ),
' ',
' ', m, n, a, nmax, aa,
540 $ lda, kl, ku, reset, transl )
543 trans = ich( ic: ic )
544 tran = trans.EQ.
'T'.OR.trans.EQ.
'C'
561 CALL smake(
'GE',
' ',
' ', 1, nl, x, 1, xx,
562 $ abs( incx ), 0, nl - 1, reset, transl )
565 xx( 1 + abs( incx )*( nl/2 - 1 ) ) = zero
581 CALL smake(
'GE',
' ',
' ', 1, ml, y, 1,
582 $ yy, abs( incy ), 0, ml - 1,
614 $
WRITE( ntra, fmt = 9994 )nc, sname,
615 $ trans, m, n, alpha, lda, incx, beta,
619 CALL sgemv( trans, m, n, alpha, aa,
620 $ lda, xx, incx, beta, yy,
622 ELSE IF( banded )
THEN
624 $
WRITE( ntra, fmt = 9995 )nc, sname,
625 $ trans, m, n, kl, ku, alpha, lda,
629 CALL sgbmv( trans, m, n, kl, ku, alpha,
630 $ aa, lda, xx, incx, beta,
637 WRITE( nout, fmt = 9993 )
644 isame( 1 ) = trans.EQ.transs
648 isame( 4 ) = als.EQ.alpha
649 isame( 5 ) = lse( as, aa, laa )
650 isame( 6 ) = ldas.EQ.lda
651 isame( 7 ) = lse( xs, xx, lx )
652 isame( 8 ) = incxs.EQ.incx
653 isame( 9 ) = bls.EQ.beta
655 isame( 10 ) = lse( ys, yy, ly )
657 isame( 10 ) = lseres(
'GE',
' ', 1,
661 isame( 11 ) = incys.EQ.incy
662 ELSE IF( banded )
THEN
663 isame( 4 ) = kls.EQ.kl
664 isame( 5 ) = kus.EQ.ku
665 isame( 6 ) = als.EQ.alpha
666 isame( 7 ) = lse( as, aa, laa )
667 isame( 8 ) = ldas.EQ.lda
668 isame( 9 ) = lse( xs, xx, lx )
669 isame( 10 ) = incxs.EQ.incx
670 isame( 11 ) = bls.EQ.beta
672 isame( 12 ) = lse( ys, yy, ly )
674 isame( 12 ) = lseres(
'GE',
' ', 1,
678 isame( 13 ) = incys.EQ.incy
686 same = same.AND.isame( i )
687 IF( .NOT.isame( i ) )
688 $
WRITE( nout, fmt = 9998 )i
699 CALL smvch( trans, m, n, alpha, a,
700 $ nmax, x, incx, beta, y,
701 $ incy, yt, g, yy, eps, err,
702 $ fatal, nout, .true. )
703 errmax = max( errmax, err )
732 IF( errmax.LT.thresh )
THEN
733 WRITE( nout, fmt = 9999 )sname, nc
735 WRITE( nout, fmt = 9997 )sname, nc, errmax
740 WRITE( nout, fmt = 9996 )sname
742 WRITE( nout, fmt = 9994 )nc, sname, trans, m, n, alpha, lda,
744 ELSE IF( banded )
THEN
745 WRITE( nout, fmt = 9995 )nc, sname, trans, m, n, kl, ku,
746 $ alpha, lda, incx, beta, incy
752 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
754 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
755 $
'ANGED INCORRECTLY *******' )
756 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
757 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
758 $
' - SUSPECT *******' )
759 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
760 9995
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', 4( i3,
',' ), f4.1,
761 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
762 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', 2( i3,
',' ), f4.1,
763 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
765 9993
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
771 SUBROUTINE schk2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
772 $ fatal, nidim, idim, nkb, kb, nalf, alf, nbet,
773 $ bet, ninc, inc, nmax, incmax, a, aa, as, x, xx,
774 $ xs, y, yy, ys, yt, g )
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 *',
1114 SUBROUTINE schk3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1115 $ fatal, nidim, idim, nkb, kb, ninc, inc, nmax,
1116 $ incmax, a, aa, as, x, xx, xs, xt, g, z )
1127 REAL ZERO, HALF, ONE
1128 parameter ( zero = 0.0, half = 0.5, one = 1.0 )
1131 INTEGER INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA
1132 LOGICAL FATAL, REWI, TRACE
1135 REAL A( nmax, nmax ), AA( nmax*nmax ),
1136 $ as( nmax*nmax ), g( nmax ), x( nmax ),
1137 $ xs( nmax*incmax ), xt( nmax ),
1138 $ xx( nmax*incmax ), z( nmax )
1139 INTEGER IDIM( nidim ), INC( ninc ), KB( nkb )
1141 REAL ERR, ERRMAX, TRANSL
1142 INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K,
1143 $ ks, laa, lda, ldas, lx, n, nargs, nc, nk, ns
1144 LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME
1145 CHARACTER*1 DIAG, DIAGS, TRANS, TRANSS, UPLO, UPLOS
1146 CHARACTER*2 ICHD, ICHU
1152 EXTERNAL lse, lseres
1159 INTEGER INFOT, NOUTC
1162 COMMON /infoc/infot, noutc, ok, lerr
1164 DATA ichu/
'UL'/, icht/
'NTC'/, ichd/
'UN'/
1166 full = sname( 3: 3 ).EQ.
'R'
1167 banded = sname( 3: 3 ).EQ.
'B'
1168 packed = sname( 3: 3 ).EQ.
'P'
1172 ELSE IF( banded )
THEN
1174 ELSE IF( packed )
THEN
1186 DO 110 in = 1, nidim
1212 laa = ( n*( n + 1 ) )/2
1219 uplo = ichu( icu: icu )
1222 trans = icht( ict: ict )
1225 diag = ichd( icd: icd )
1230 CALL smake( sname( 2: 3 ), uplo, diag, n, n, a,
1231 $ nmax, aa, lda, k, k, reset, transl )
1240 CALL smake(
'GE',
' ',
' ', 1, n, x, 1, xx,
1241 $ abs( incx ), 0, n - 1, reset,
1245 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
1268 IF( sname( 4: 5 ).EQ.
'MV' )
THEN
1271 $
WRITE( ntra, fmt = 9993 )nc, sname,
1272 $ uplo, trans, diag, n, lda, incx
1275 CALL strmv( uplo, trans, diag, n, aa, lda,
1277 ELSE IF( banded )
THEN
1279 $
WRITE( ntra, fmt = 9994 )nc, sname,
1280 $ uplo, trans, diag, n, k, lda, incx
1283 CALL stbmv( uplo, trans, diag, n, k, aa,
1285 ELSE IF( packed )
THEN
1287 $
WRITE( ntra, fmt = 9995 )nc, sname,
1288 $ uplo, trans, diag, n, incx
1291 CALL stpmv( uplo, trans, diag, n, aa, xx,
1294 ELSE IF( sname( 4: 5 ).EQ.
'SV' )
THEN
1297 $
WRITE( ntra, fmt = 9993 )nc, sname,
1298 $ uplo, trans, diag, n, lda, incx
1301 CALL strsv( uplo, trans, diag, n, aa, lda,
1303 ELSE IF( banded )
THEN
1305 $
WRITE( ntra, fmt = 9994 )nc, sname,
1306 $ uplo, trans, diag, n, k, lda, incx
1309 CALL stbsv( uplo, trans, diag, n, k, aa,
1311 ELSE IF( packed )
THEN
1313 $
WRITE( ntra, fmt = 9995 )nc, sname,
1314 $ uplo, trans, diag, n, incx
1317 CALL stpsv( uplo, trans, diag, n, aa, xx,
1325 WRITE( nout, fmt = 9992 )
1332 isame( 1 ) = uplo.EQ.uplos
1333 isame( 2 ) = trans.EQ.transs
1334 isame( 3 ) = diag.EQ.diags
1335 isame( 4 ) = ns.EQ.n
1337 isame( 5 ) = lse( as, aa, laa )
1338 isame( 6 ) = ldas.EQ.lda
1340 isame( 7 ) = lse( xs, xx, lx )
1342 isame( 7 ) = lseres(
'GE',
' ', 1, n, xs,
1345 isame( 8 ) = incxs.EQ.incx
1346 ELSE IF( banded )
THEN
1347 isame( 5 ) = ks.EQ.k
1348 isame( 6 ) = lse( as, aa, laa )
1349 isame( 7 ) = ldas.EQ.lda
1351 isame( 8 ) = lse( xs, xx, lx )
1353 isame( 8 ) = lseres(
'GE',
' ', 1, n, xs,
1356 isame( 9 ) = incxs.EQ.incx
1357 ELSE IF( packed )
THEN
1358 isame( 5 ) = lse( as, aa, laa )
1360 isame( 6 ) = lse( xs, xx, lx )
1362 isame( 6 ) = lseres(
'GE',
' ', 1, n, xs,
1365 isame( 7 ) = incxs.EQ.incx
1373 same = same.AND.isame( i )
1374 IF( .NOT.isame( i ) )
1375 $
WRITE( nout, fmt = 9998 )i
1383 IF( sname( 4: 5 ).EQ.
'MV' )
THEN
1387 CALL smvch( trans, n, n, one, a, nmax, x,
1388 $ incx, zero, z, incx, xt, g,
1389 $ xx, eps, err, fatal, nout,
1391 ELSE IF( sname( 4: 5 ).EQ.
'SV' )
THEN
1396 z( i ) = xx( 1 + ( i - 1 )*
1398 xx( 1 + ( i - 1 )*abs( incx ) )
1401 CALL smvch( trans, n, n, one, a, nmax, z,
1402 $ incx, zero, x, incx, xt, g,
1403 $ xx, eps, err, fatal, nout,
1406 errmax = max( errmax, err )
1429 IF( errmax.LT.thresh )
THEN
1430 WRITE( nout, fmt = 9999 )sname, nc
1432 WRITE( nout, fmt = 9997 )sname, nc, errmax
1437 WRITE( nout, fmt = 9996 )sname
1439 WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, diag, n, lda,
1441 ELSE IF( banded )
THEN
1442 WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, diag, n, k,
1444 ELSE IF( packed )
THEN
1445 WRITE( nout, fmt = 9995 )nc, sname, uplo, trans, diag, n, incx
1451 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1453 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1454 $
'ANGED INCORRECTLY *******' )
1455 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1456 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1457 $
' - SUSPECT *******' )
1458 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1459 9995
FORMAT( 1x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), i3,
', AP, ',
1461 9994
FORMAT( 1x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), 2( i3,
',' ),
1462 $
' A,', i3,
', X,', i2,
') .' )
1463 9993
FORMAT( 1x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), i3,
', A,',
1464 $ i3,
', X,', i2,
') .' )
1465 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1471 SUBROUTINE schk4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1472 $ fatal, nidim, idim, nalf, alf, ninc, inc, nmax,
1473 $ incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g,
1485 REAL ZERO, HALF, ONE
1486 parameter ( zero = 0.0, half = 0.5, one = 1.0 )
1489 INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
1490 LOGICAL FATAL, REWI, TRACE
1493 REAL A( nmax, nmax ), AA( nmax*nmax ), ALF( nalf ),
1494 $ as( nmax*nmax ), g( nmax ), x( nmax ),
1495 $ xs( nmax*incmax ), xx( nmax*incmax ),
1496 $ y( nmax ), ys( nmax*incmax ), yt( nmax ),
1497 $ yy( nmax*incmax ), z( nmax )
1498 INTEGER IDIM( nidim ), INC( ninc )
1500 REAL ALPHA, ALS, ERR, ERRMAX, TRANSL
1501 INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX,
1502 $ iy, j, laa, lda, ldas, lx, ly, m, ms, n, nargs,
1504 LOGICAL NULL, RESET, SAME
1510 EXTERNAL lse, lseres
1514 INTRINSIC abs, max, min
1516 INTEGER INFOT, NOUTC
1519 COMMON /infoc/infot, noutc, ok, lerr
1528 DO 120 in = 1, nidim
1534 $ m = max( n - nd, 0 )
1536 $ m = min( n + nd, nmax )
1546 null = n.LE.0.OR.m.LE.0
1555 CALL smake(
'GE',
' ',
' ', 1, m, x, 1, xx, abs( incx ),
1556 $ 0, m - 1, reset, transl )
1559 xx( 1 + abs( incx )*( m/2 - 1 ) ) = zero
1569 CALL smake(
'GE',
' ',
' ', 1, n, y, 1, yy,
1570 $ abs( incy ), 0, n - 1, reset, transl )
1573 yy( 1 + abs( incy )*( n/2 - 1 ) ) = zero
1582 CALL smake( sname( 2: 3 ),
' ',
' ', m, n, a, nmax,
1583 $ aa, lda, m - 1, n - 1, reset, transl )
1608 $
WRITE( ntra, fmt = 9994 )nc, sname, m, n,
1609 $ alpha, incx, incy, lda
1612 CALL sger( m, n, alpha, xx, incx, yy, incy, aa,
1618 WRITE( nout, fmt = 9993 )
1625 isame( 1 ) = ms.EQ.m
1626 isame( 2 ) = ns.EQ.n
1627 isame( 3 ) = als.EQ.alpha
1628 isame( 4 ) = lse( xs, xx, lx )
1629 isame( 5 ) = incxs.EQ.incx
1630 isame( 6 ) = lse( ys, yy, ly )
1631 isame( 7 ) = incys.EQ.incy
1633 isame( 8 ) = lse( as, aa, laa )
1635 isame( 8 ) = lseres(
'GE',
' ', m, n, as, aa,
1638 isame( 9 ) = ldas.EQ.lda
1644 same = same.AND.isame( i )
1645 IF( .NOT.isame( i ) )
1646 $
WRITE( nout, fmt = 9998 )i
1663 z( i ) = x( m - i + 1 )
1670 w( 1 ) = y( n - j + 1 )
1672 CALL smvch(
'N', m, 1, alpha, z, nmax, w, 1,
1673 $ one, a( 1, j ), 1, yt, g,
1674 $ aa( 1 + ( j - 1 )*lda ), eps,
1675 $ err, fatal, nout, .true. )
1676 errmax = max( errmax, err )
1698 IF( errmax.LT.thresh )
THEN
1699 WRITE( nout, fmt = 9999 )sname, nc
1701 WRITE( nout, fmt = 9997 )sname, nc, errmax
1706 WRITE( nout, fmt = 9995 )j
1709 WRITE( nout, fmt = 9996 )sname
1710 WRITE( nout, fmt = 9994 )nc, sname, m, n, alpha, incx, incy, lda
1715 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1717 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1718 $
'ANGED INCORRECTLY *******' )
1719 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1720 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1721 $
' - SUSPECT *******' )
1722 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1723 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1724 9994
FORMAT( 1x, i6,
': ', a6,
'(', 2( i3,
',' ), f4.1,
', X,', i2,
1725 $
', Y,', i2,
', A,', i3,
') .' )
1726 9993
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1732 SUBROUTINE schk5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1733 $ fatal, nidim, idim, nalf, alf, ninc, inc, nmax,
1734 $ incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g,
1746 REAL ZERO, HALF, ONE
1747 parameter ( zero = 0.0, half = 0.5, one = 1.0 )
1750 INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
1751 LOGICAL FATAL, REWI, TRACE
1754 REAL A( nmax, nmax ), AA( nmax*nmax ), ALF( nalf ),
1755 $ as( nmax*nmax ), g( nmax ), x( nmax ),
1756 $ xs( nmax*incmax ), xx( nmax*incmax ),
1757 $ y( nmax ), ys( nmax*incmax ), yt( nmax ),
1758 $ yy( nmax*incmax ), z( nmax )
1759 INTEGER IDIM( nidim ), INC( ninc )
1761 REAL ALPHA, ALS, ERR, ERRMAX, TRANSL
1762 INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA,
1763 $ lda, ldas, lj, lx, n, nargs, nc, ns
1764 LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER
1765 CHARACTER*1 UPLO, UPLOS
1772 EXTERNAL lse, lseres
1778 INTEGER INFOT, NOUTC
1781 COMMON /infoc/infot, noutc, ok, lerr
1785 full = sname( 3: 3 ).EQ.
'Y'
1786 packed = sname( 3: 3 ).EQ.
'P'
1790 ELSE IF( packed )
THEN
1798 DO 100 in = 1, nidim
1808 laa = ( n*( n + 1 ) )/2
1814 uplo = ich( ic: ic )
1824 CALL smake(
'GE',
' ',
' ', 1, n, x, 1, xx, abs( incx ),
1825 $ 0, n - 1, reset, transl )
1828 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
1833 null = n.LE.0.OR.alpha.EQ.zero
1838 CALL smake( sname( 2: 3 ), uplo,
' ', n, n, a, nmax,
1839 $ aa, lda, n - 1, n - 1, reset, transl )
1861 $
WRITE( ntra, fmt = 9993 )nc, sname, uplo, n,
1865 CALL ssyr( uplo, n, alpha, xx, incx, aa, lda )
1866 ELSE IF( packed )
THEN
1868 $
WRITE( ntra, fmt = 9994 )nc, sname, uplo, n,
1872 CALL sspr( uplo, n, alpha, xx, incx, aa )
1878 WRITE( nout, fmt = 9992 )
1885 isame( 1 ) = uplo.EQ.uplos
1886 isame( 2 ) = ns.EQ.n
1887 isame( 3 ) = als.EQ.alpha
1888 isame( 4 ) = lse( xs, xx, lx )
1889 isame( 5 ) = incxs.EQ.incx
1891 isame( 6 ) = lse( as, aa, laa )
1893 isame( 6 ) = lseres( sname( 2: 3 ), uplo, n, n, as,
1896 IF( .NOT.packed )
THEN
1897 isame( 7 ) = ldas.EQ.lda
1904 same = same.AND.isame( i )
1905 IF( .NOT.isame( i ) )
1906 $
WRITE( nout, fmt = 9998 )i
1923 z( i ) = x( n - i + 1 )
1936 CALL smvch(
'N', lj, 1, alpha, z( jj ), lj, w,
1937 $ 1, one, a( jj, j ), 1, yt, g,
1938 $ aa( ja ), eps, err, fatal, nout,
1949 errmax = max( errmax, err )
1970 IF( errmax.LT.thresh )
THEN
1971 WRITE( nout, fmt = 9999 )sname, nc
1973 WRITE( nout, fmt = 9997 )sname, nc, errmax
1978 WRITE( nout, fmt = 9995 )j
1981 WRITE( nout, fmt = 9996 )sname
1983 WRITE( nout, fmt = 9993 )nc, sname, uplo, n, alpha, incx, lda
1984 ELSE IF( packed )
THEN
1985 WRITE( nout, fmt = 9994 )nc, sname, uplo, n, alpha, incx
1991 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1993 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1994 $
'ANGED INCORRECTLY *******' )
1995 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1996 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1997 $
' - SUSPECT *******' )
1998 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1999 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
2000 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2002 9993
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2003 $ i2,
', A,', i3,
') .' )
2004 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
2010 SUBROUTINE schk6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
2011 $ fatal, nidim, idim, nalf, alf, ninc, inc, nmax,
2012 $ incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g,
2024 REAL ZERO, HALF, ONE
2025 parameter ( zero = 0.0, half = 0.5, one = 1.0 )
2028 INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
2029 LOGICAL FATAL, REWI, TRACE
2032 REAL A( nmax, nmax ), AA( nmax*nmax ), ALF( nalf ),
2033 $ as( nmax*nmax ), g( nmax ), x( nmax ),
2034 $ xs( nmax*incmax ), xx( nmax*incmax ),
2035 $ y( nmax ), ys( nmax*incmax ), yt( nmax ),
2036 $ yy( nmax*incmax ), z( nmax, 2 )
2037 INTEGER IDIM( nidim ), INC( ninc )
2039 REAL ALPHA, ALS, ERR, ERRMAX, TRANSL
2040 INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX,
2041 $ iy, j, ja, jj, laa, lda, ldas, lj, lx, ly, n,
2043 LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER
2044 CHARACTER*1 UPLO, UPLOS
2051 EXTERNAL lse, lseres
2057 INTEGER INFOT, NOUTC
2060 COMMON /infoc/infot, noutc, ok, lerr
2064 full = sname( 3: 3 ).EQ.
'Y'
2065 packed = sname( 3: 3 ).EQ.
'P'
2069 ELSE IF( packed )
THEN
2077 DO 140 in = 1, nidim
2087 laa = ( n*( n + 1 ) )/2
2093 uplo = ich( ic: ic )
2103 CALL smake(
'GE',
' ',
' ', 1, n, x, 1, xx, abs( incx ),
2104 $ 0, n - 1, reset, transl )
2107 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
2117 CALL smake(
'GE',
' ',
' ', 1, n, y, 1, yy,
2118 $ abs( incy ), 0, n - 1, reset, transl )
2121 yy( 1 + abs( incy )*( n/2 - 1 ) ) = zero
2126 null = n.LE.0.OR.alpha.EQ.zero
2131 CALL smake( sname( 2: 3 ), uplo,
' ', n, n, a,
2132 $ nmax, aa, lda, n - 1, n - 1, reset,
2159 $
WRITE( ntra, fmt = 9993 )nc, sname, uplo, n,
2160 $ alpha, incx, incy, lda
2163 CALL ssyr2( uplo, n, alpha, xx, incx, yy, incy,
2165 ELSE IF( packed )
THEN
2167 $
WRITE( ntra, fmt = 9994 )nc, sname, uplo, n,
2171 CALL sspr2( uplo, n, alpha, xx, incx, yy, incy,
2178 WRITE( nout, fmt = 9992 )
2185 isame( 1 ) = uplo.EQ.uplos
2186 isame( 2 ) = ns.EQ.n
2187 isame( 3 ) = als.EQ.alpha
2188 isame( 4 ) = lse( xs, xx, lx )
2189 isame( 5 ) = incxs.EQ.incx
2190 isame( 6 ) = lse( ys, yy, ly )
2191 isame( 7 ) = incys.EQ.incy
2193 isame( 8 ) = lse( as, aa, laa )
2195 isame( 8 ) = lseres( sname( 2: 3 ), uplo, n, n,
2198 IF( .NOT.packed )
THEN
2199 isame( 9 ) = ldas.EQ.lda
2206 same = same.AND.isame( i )
2207 IF( .NOT.isame( i ) )
2208 $
WRITE( nout, fmt = 9998 )i
2225 z( i, 1 ) = x( n - i + 1 )
2234 z( i, 2 ) = y( n - i + 1 )
2248 CALL smvch(
'N', lj, 2, alpha, z( jj, 1 ),
2249 $ nmax, w, 1, one, a( jj, j ), 1,
2250 $ yt, g, aa( ja ), eps, err, fatal,
2261 errmax = max( errmax, err )
2284 IF( errmax.LT.thresh )
THEN
2285 WRITE( nout, fmt = 9999 )sname, nc
2287 WRITE( nout, fmt = 9997 )sname, nc, errmax
2292 WRITE( nout, fmt = 9995 )j
2295 WRITE( nout, fmt = 9996 )sname
2297 WRITE( nout, fmt = 9993 )nc, sname, uplo, n, alpha, incx,
2299 ELSE IF( packed )
THEN
2300 WRITE( nout, fmt = 9994 )nc, sname, uplo, n, alpha, incx, incy
2306 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
2308 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
2309 $
'ANGED INCORRECTLY *******' )
2310 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
2311 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
2312 $
' - SUSPECT *******' )
2313 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
2314 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
2315 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2316 $ i2,
', Y,', i2,
', AP) .' )
2317 9993
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2318 $ i2,
', Y,', i2,
', A,', i3,
') .' )
2319 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
2325 SUBROUTINE schke( ISNUM, SRNAMT, NOUT )
2341 INTEGER INFOT, NOUTC
2346 REAL A( 1, 1 ), X( 1 ), Y( 1 )
2352 COMMON /infoc/infot, noutc, ok, lerr
2360 GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
2361 $ 90, 100, 110, 120, 130, 140, 150,
2364 CALL sgemv(
'/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2365 CALL chkxer( srnamt, infot, nout, lerr, ok )
2367 CALL sgemv(
'N', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2368 CALL chkxer( srnamt, infot, nout, lerr, ok )
2370 CALL sgemv(
'N', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2371 CALL chkxer( srnamt, infot, nout, lerr, ok )
2373 CALL sgemv(
'N', 2, 0, alpha, a, 1, x, 1, beta, y, 1 )
2374 CALL chkxer( srnamt, infot, nout, lerr, ok )
2376 CALL sgemv(
'N', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2377 CALL chkxer( srnamt, infot, nout, lerr, ok )
2379 CALL sgemv(
'N', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2380 CALL chkxer( srnamt, infot, nout, lerr, ok )
2383 CALL sgbmv(
'/', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2384 CALL chkxer( srnamt, infot, nout, lerr, ok )
2386 CALL sgbmv(
'N', -1, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2387 CALL chkxer( srnamt, infot, nout, lerr, ok )
2389 CALL sgbmv(
'N', 0, -1, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2390 CALL chkxer( srnamt, infot, nout, lerr, ok )
2392 CALL sgbmv(
'N', 0, 0, -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2393 CALL chkxer( srnamt, infot, nout, lerr, ok )
2395 CALL sgbmv(
'N', 2, 0, 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2396 CALL chkxer( srnamt, infot, nout, lerr, ok )
2398 CALL sgbmv(
'N', 0, 0, 1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2399 CALL chkxer( srnamt, infot, nout, lerr, ok )
2401 CALL sgbmv(
'N', 0, 0, 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2402 CALL chkxer( srnamt, infot, nout, lerr, ok )
2404 CALL sgbmv(
'N', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2405 CALL chkxer( srnamt, infot, nout, lerr, ok )
2408 CALL ssymv(
'/', 0, alpha, a, 1, x, 1, beta, y, 1 )
2409 CALL chkxer( srnamt, infot, nout, lerr, ok )
2411 CALL ssymv(
'U', -1, alpha, a, 1, x, 1, beta, y, 1 )
2412 CALL chkxer( srnamt, infot, nout, lerr, ok )
2414 CALL ssymv(
'U', 2, alpha, a, 1, x, 1, beta, y, 1 )
2415 CALL chkxer( srnamt, infot, nout, lerr, ok )
2417 CALL ssymv(
'U', 0, alpha, a, 1, x, 0, beta, y, 1 )
2418 CALL chkxer( srnamt, infot, nout, lerr, ok )
2420 CALL ssymv(
'U', 0, alpha, a, 1, x, 1, beta, y, 0 )
2421 CALL chkxer( srnamt, infot, nout, lerr, ok )
2424 CALL ssbmv(
'/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2425 CALL chkxer( srnamt, infot, nout, lerr, ok )
2427 CALL ssbmv(
'U', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2428 CALL chkxer( srnamt, infot, nout, lerr, ok )
2430 CALL ssbmv(
'U', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2431 CALL chkxer( srnamt, infot, nout, lerr, ok )
2433 CALL ssbmv(
'U', 0, 1, alpha, a, 1, x, 1, beta, y, 1 )
2434 CALL chkxer( srnamt, infot, nout, lerr, ok )
2436 CALL ssbmv(
'U', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2437 CALL chkxer( srnamt, infot, nout, lerr, ok )
2439 CALL ssbmv(
'U', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2440 CALL chkxer( srnamt, infot, nout, lerr, ok )
2443 CALL sspmv(
'/', 0, alpha, a, x, 1, beta, y, 1 )
2444 CALL chkxer( srnamt, infot, nout, lerr, ok )
2446 CALL sspmv(
'U', -1, alpha, a, x, 1, beta, y, 1 )
2447 CALL chkxer( srnamt, infot, nout, lerr, ok )
2449 CALL sspmv(
'U', 0, alpha, a, x, 0, beta, y, 1 )
2450 CALL chkxer( srnamt, infot, nout, lerr, ok )
2452 CALL sspmv(
'U', 0, alpha, a, x, 1, beta, y, 0 )
2453 CALL chkxer( srnamt, infot, nout, lerr, ok )
2456 CALL strmv(
'/',
'N',
'N', 0, a, 1, x, 1 )
2457 CALL chkxer( srnamt, infot, nout, lerr, ok )
2459 CALL strmv(
'U',
'/',
'N', 0, a, 1, x, 1 )
2460 CALL chkxer( srnamt, infot, nout, lerr, ok )
2462 CALL strmv(
'U',
'N',
'/', 0, a, 1, x, 1 )
2463 CALL chkxer( srnamt, infot, nout, lerr, ok )
2465 CALL strmv(
'U',
'N',
'N', -1, a, 1, x, 1 )
2466 CALL chkxer( srnamt, infot, nout, lerr, ok )
2468 CALL strmv(
'U',
'N',
'N', 2, a, 1, x, 1 )
2469 CALL chkxer( srnamt, infot, nout, lerr, ok )
2471 CALL strmv(
'U',
'N',
'N', 0, a, 1, x, 0 )
2472 CALL chkxer( srnamt, infot, nout, lerr, ok )
2475 CALL stbmv(
'/',
'N',
'N', 0, 0, a, 1, x, 1 )
2476 CALL chkxer( srnamt, infot, nout, lerr, ok )
2478 CALL stbmv(
'U',
'/',
'N', 0, 0, a, 1, x, 1 )
2479 CALL chkxer( srnamt, infot, nout, lerr, ok )
2481 CALL stbmv(
'U',
'N',
'/', 0, 0, a, 1, x, 1 )
2482 CALL chkxer( srnamt, infot, nout, lerr, ok )
2484 CALL stbmv(
'U',
'N',
'N', -1, 0, a, 1, x, 1 )
2485 CALL chkxer( srnamt, infot, nout, lerr, ok )
2487 CALL stbmv(
'U',
'N',
'N', 0, -1, a, 1, x, 1 )
2488 CALL chkxer( srnamt, infot, nout, lerr, ok )
2490 CALL stbmv(
'U',
'N',
'N', 0, 1, a, 1, x, 1 )
2491 CALL chkxer( srnamt, infot, nout, lerr, ok )
2493 CALL stbmv(
'U',
'N',
'N', 0, 0, a, 1, x, 0 )
2494 CALL chkxer( srnamt, infot, nout, lerr, ok )
2497 CALL stpmv(
'/',
'N',
'N', 0, a, x, 1 )
2498 CALL chkxer( srnamt, infot, nout, lerr, ok )
2500 CALL stpmv(
'U',
'/',
'N', 0, a, x, 1 )
2501 CALL chkxer( srnamt, infot, nout, lerr, ok )
2503 CALL stpmv(
'U',
'N',
'/', 0, a, x, 1 )
2504 CALL chkxer( srnamt, infot, nout, lerr, ok )
2506 CALL stpmv(
'U',
'N',
'N', -1, a, x, 1 )
2507 CALL chkxer( srnamt, infot, nout, lerr, ok )
2509 CALL stpmv(
'U',
'N',
'N', 0, a, x, 0 )
2510 CALL chkxer( srnamt, infot, nout, lerr, ok )
2513 CALL strsv(
'/',
'N',
'N', 0, a, 1, x, 1 )
2514 CALL chkxer( srnamt, infot, nout, lerr, ok )
2516 CALL strsv(
'U',
'/',
'N', 0, a, 1, x, 1 )
2517 CALL chkxer( srnamt, infot, nout, lerr, ok )
2519 CALL strsv(
'U',
'N',
'/', 0, a, 1, x, 1 )
2520 CALL chkxer( srnamt, infot, nout, lerr, ok )
2522 CALL strsv(
'U',
'N',
'N', -1, a, 1, x, 1 )
2523 CALL chkxer( srnamt, infot, nout, lerr, ok )
2525 CALL strsv(
'U',
'N',
'N', 2, a, 1, x, 1 )
2526 CALL chkxer( srnamt, infot, nout, lerr, ok )
2528 CALL strsv(
'U',
'N',
'N', 0, a, 1, x, 0 )
2529 CALL chkxer( srnamt, infot, nout, lerr, ok )
2532 CALL stbsv(
'/',
'N',
'N', 0, 0, a, 1, x, 1 )
2533 CALL chkxer( srnamt, infot, nout, lerr, ok )
2535 CALL stbsv(
'U',
'/',
'N', 0, 0, a, 1, x, 1 )
2536 CALL chkxer( srnamt, infot, nout, lerr, ok )
2538 CALL stbsv(
'U',
'N',
'/', 0, 0, a, 1, x, 1 )
2539 CALL chkxer( srnamt, infot, nout, lerr, ok )
2541 CALL stbsv(
'U',
'N',
'N', -1, 0, a, 1, x, 1 )
2542 CALL chkxer( srnamt, infot, nout, lerr, ok )
2544 CALL stbsv(
'U',
'N',
'N', 0, -1, a, 1, x, 1 )
2545 CALL chkxer( srnamt, infot, nout, lerr, ok )
2547 CALL stbsv(
'U',
'N',
'N', 0, 1, a, 1, x, 1 )
2548 CALL chkxer( srnamt, infot, nout, lerr, ok )
2550 CALL stbsv(
'U',
'N',
'N', 0, 0, a, 1, x, 0 )
2551 CALL chkxer( srnamt, infot, nout, lerr, ok )
2554 CALL stpsv(
'/',
'N',
'N', 0, a, x, 1 )
2555 CALL chkxer( srnamt, infot, nout, lerr, ok )
2557 CALL stpsv(
'U',
'/',
'N', 0, a, x, 1 )
2558 CALL chkxer( srnamt, infot, nout, lerr, ok )
2560 CALL stpsv(
'U',
'N',
'/', 0, a, x, 1 )
2561 CALL chkxer( srnamt, infot, nout, lerr, ok )
2563 CALL stpsv(
'U',
'N',
'N', -1, a, x, 1 )
2564 CALL chkxer( srnamt, infot, nout, lerr, ok )
2566 CALL stpsv(
'U',
'N',
'N', 0, a, x, 0 )
2567 CALL chkxer( srnamt, infot, nout, lerr, ok )
2570 CALL sger( -1, 0, alpha, x, 1, y, 1, a, 1 )
2571 CALL chkxer( srnamt, infot, nout, lerr, ok )
2573 CALL sger( 0, -1, alpha, x, 1, y, 1, a, 1 )
2574 CALL chkxer( srnamt, infot, nout, lerr, ok )
2576 CALL sger( 0, 0, alpha, x, 0, y, 1, a, 1 )
2577 CALL chkxer( srnamt, infot, nout, lerr, ok )
2579 CALL sger( 0, 0, alpha, x, 1, y, 0, a, 1 )
2580 CALL chkxer( srnamt, infot, nout, lerr, ok )
2582 CALL sger( 2, 0, alpha, x, 1, y, 1, a, 1 )
2583 CALL chkxer( srnamt, infot, nout, lerr, ok )
2586 CALL ssyr(
'/', 0, alpha, x, 1, a, 1 )
2587 CALL chkxer( srnamt, infot, nout, lerr, ok )
2589 CALL ssyr(
'U', -1, alpha, x, 1, a, 1 )
2590 CALL chkxer( srnamt, infot, nout, lerr, ok )
2592 CALL ssyr(
'U', 0, alpha, x, 0, a, 1 )
2593 CALL chkxer( srnamt, infot, nout, lerr, ok )
2595 CALL ssyr(
'U', 2, alpha, x, 1, a, 1 )
2596 CALL chkxer( srnamt, infot, nout, lerr, ok )
2599 CALL sspr(
'/', 0, alpha, x, 1, a )
2600 CALL chkxer( srnamt, infot, nout, lerr, ok )
2602 CALL sspr(
'U', -1, alpha, x, 1, a )
2603 CALL chkxer( srnamt, infot, nout, lerr, ok )
2605 CALL sspr(
'U', 0, alpha, x, 0, a )
2606 CALL chkxer( srnamt, infot, nout, lerr, ok )
2609 CALL ssyr2(
'/', 0, alpha, x, 1, y, 1, a, 1 )
2610 CALL chkxer( srnamt, infot, nout, lerr, ok )
2612 CALL ssyr2(
'U', -1, alpha, x, 1, y, 1, a, 1 )
2613 CALL chkxer( srnamt, infot, nout, lerr, ok )
2615 CALL ssyr2(
'U', 0, alpha, x, 0, y, 1, a, 1 )
2616 CALL chkxer( srnamt, infot, nout, lerr, ok )
2618 CALL ssyr2(
'U', 0, alpha, x, 1, y, 0, a, 1 )
2619 CALL chkxer( srnamt, infot, nout, lerr, ok )
2621 CALL ssyr2(
'U', 2, alpha, x, 1, y, 1, a, 1 )
2622 CALL chkxer( srnamt, infot, nout, lerr, ok )
2625 CALL sspr2(
'/', 0, alpha, x, 1, y, 1, a )
2626 CALL chkxer( srnamt, infot, nout, lerr, ok )
2628 CALL sspr2(
'U', -1, alpha, x, 1, y, 1, a )
2629 CALL chkxer( srnamt, infot, nout, lerr, ok )
2631 CALL sspr2(
'U', 0, alpha, x, 0, y, 1, a )
2632 CALL chkxer( srnamt, infot, nout, lerr, ok )
2634 CALL sspr2(
'U', 0, alpha, x, 1, y, 0, a )
2635 CALL chkxer( srnamt, infot, nout, lerr, ok )
2638 WRITE( nout, fmt = 9999 )srnamt
2640 WRITE( nout, fmt = 9998 )srnamt
2644 9999
FORMAT(
' ', a6,
' PASSED THE TESTS OF ERROR-EXITS' )
2645 9998
FORMAT(
' ******* ', a6,
' FAILED THE TESTS OF ERROR-EXITS *****',
2651 SUBROUTINE smake( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL,
2652 $ ku, reset, transl )
2669 parameter ( zero = 0.0, one = 1.0 )
2671 parameter ( rogue = -1.0e10 )
2674 INTEGER KL, KU, LDA, M, N, NMAX
2676 CHARACTER*1 DIAG, UPLO
2679 REAL A( nmax, * ), AA( * )
2681 INTEGER I, I1, I2, I3, IBEG, IEND, IOFF, J, KK
2682 LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER
2689 gen =
TYPE( 1: 1 ).EQ.
'G'
2690 sym =
TYPE( 1: 1 ).EQ.
'S'
2691 tri =
TYPE( 1: 1 ).EQ.
'T'
2692 upper = ( sym.OR.tri ).AND.uplo.EQ.
'U'
2693 lower = ( sym.OR.tri ).AND.uplo.EQ.
'L'
2694 unit = tri.AND.diag.EQ.
'U'
2700 IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2702 IF( ( i.LE.j.AND.j - i.LE.ku ).OR.
2703 $ ( i.GE.j.AND.i - j.LE.kl ) )
THEN
2704 a( i, j ) = sbeg( reset ) + transl
2710 a( j, i ) = a( i, j )
2718 $ a( j, j ) = a( j, j ) + one
2725 IF( type.EQ.
'GE' )
THEN
2728 aa( i + ( j - 1 )*lda ) = a( i, j )
2730 DO 40 i = m + 1, lda
2731 aa( i + ( j - 1 )*lda ) = rogue
2734 ELSE IF( type.EQ.
'GB' )
THEN
2736 DO 60 i1 = 1, ku + 1 - j
2737 aa( i1 + ( j - 1 )*lda ) = rogue
2739 DO 70 i2 = i1, min( kl + ku + 1, ku + 1 + m - j )
2740 aa( i2 + ( j - 1 )*lda ) = a( i2 + j - ku - 1, j )
2743 aa( i3 + ( j - 1 )*lda ) = rogue
2746 ELSE IF( type.EQ.
'SY'.OR.type.EQ.
'TR' )
THEN
2763 DO 100 i = 1, ibeg - 1
2764 aa( i + ( j - 1 )*lda ) = rogue
2766 DO 110 i = ibeg, iend
2767 aa( i + ( j - 1 )*lda ) = a( i, j )
2769 DO 120 i = iend + 1, lda
2770 aa( i + ( j - 1 )*lda ) = rogue
2773 ELSE IF( type.EQ.
'SB'.OR.type.EQ.
'TB' )
THEN
2777 ibeg = max( 1, kl + 2 - j )
2790 iend = min( kl + 1, 1 + m - j )
2792 DO 140 i = 1, ibeg - 1
2793 aa( i + ( j - 1 )*lda ) = rogue
2795 DO 150 i = ibeg, iend
2796 aa( i + ( j - 1 )*lda ) = a( i + j - kk, j )
2798 DO 160 i = iend + 1, lda
2799 aa( i + ( j - 1 )*lda ) = rogue
2802 ELSE IF( type.EQ.
'SP'.OR.type.EQ.
'TP' )
THEN
2812 DO 180 i = ibeg, iend
2814 aa( ioff ) = a( i, j )
2817 $ aa( ioff ) = rogue
2827 SUBROUTINE smvch( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y,
2828 $ incy, yt, g, yy, eps, err, fatal, nout, mv )
2840 parameter ( zero = 0.0, one = 1.0 )
2842 REAL ALPHA, BETA, EPS, ERR
2843 INTEGER INCX, INCY, M, N, NMAX, NOUT
2847 REAL A( nmax, * ), G( * ), X( * ), Y( * ), YT( * ),
2851 INTEGER I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
2854 INTRINSIC abs, max, sqrt
2856 tran = trans.EQ.
'T'.OR.trans.EQ.
'C'
2889 yt( iy ) = yt( iy ) + a( j, i )*x( jx )
2890 g( iy ) = g( iy ) + abs( a( j, i )*x( jx ) )
2895 yt( iy ) = yt( iy ) + a( i, j )*x( jx )
2896 g( iy ) = g( iy ) + abs( a( i, j )*x( jx ) )
2900 yt( iy ) = alpha*yt( iy ) + beta*y( iy )
2901 g( iy ) = abs( alpha )*g( iy ) + abs( beta*y( iy ) )
2909 erri = abs( yt( i ) - yy( 1 + ( i - 1 )*abs( incy ) ) )/eps
2910 IF( g( i ).NE.zero )
2911 $ erri = erri/g( i )
2912 err = max( err, erri )
2913 IF( err*sqrt( eps ).GE.one )
2922 WRITE( nout, fmt = 9999 )
2925 WRITE( nout, fmt = 9998 )i, yt( i ),
2926 $ yy( 1 + ( i - 1 )*abs( incy ) )
2928 WRITE( nout, fmt = 9998 )i,
2929 $ yy( 1 + ( i - 1 )*abs( incy ) ), yt(i)
2936 9999
FORMAT(
' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
2937 $
'F ACCURATE *******', /
' EXPECTED RESULT COMPU',
2939 9998
FORMAT( 1x, i7, 2g18.6 )
2944 LOGICAL FUNCTION lse( RI, RJ, LR )
2957 REAL RI( * ), RJ( * )
2962 IF( ri( i ).NE.rj( i ) )
2974 LOGICAL FUNCTION lseres( TYPE, UPLO, M, N, AA, AS, LDA )
2991 REAL AA( lda, * ), AS( lda, * )
2993 INTEGER I, IBEG, IEND, J
2997 IF( type.EQ.
'GE' )
THEN
2999 DO 10 i = m + 1, lda
3000 IF( aa( i, j ).NE.as( i, j ) )
3004 ELSE IF( type.EQ.
'SY' )
THEN
3013 DO 30 i = 1, ibeg - 1
3014 IF( aa( i, j ).NE.as( i, j ) )
3017 DO 40 i = iend + 1, lda
3018 IF( aa( i, j ).NE.as( i, j ) )
3033 REAL FUNCTION sbeg( RESET )
3068 i = i - 1000*( i/1000 )
3073 sbeg =
REAL( i - 500 )/1001.0
3079 REAL FUNCTION sdiff( X, Y )
3095 SUBROUTINE chkxer( SRNAMT, INFOT, NOUT, LERR, OK )
3111 WRITE( nout, fmt = 9999 )infot, srnamt
3117 9999
FORMAT(
' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', i2,
' NOT D',
3118 $
'ETECTED BY ', a6,
' *****' )
3123 SUBROUTINE xerbla( SRNAME, INFO )
3148 COMMON /infoc/infot, nout, ok, lerr
3149 COMMON /srnamc/srnamt
3152 IF( info.NE.infot )
THEN
3153 IF( infot.NE.0 )
THEN
3154 WRITE( nout, fmt = 9999 )info, infot
3156 WRITE( nout, fmt = 9997 )info
3160 IF( srname.NE.srnamt )
THEN
3161 WRITE( nout, fmt = 9998 )srname, srnamt
3166 9999
FORMAT(
' ******* XERBLA WAS CALLED WITH INFO = ', i6,
' INSTEAD',
3167 $
' OF ', i2,
' *******' )
3168 9998
FORMAT(
' ******* XERBLA WAS CALLED WITH SRNAME = ', a6,
' INSTE',
3169 $
'AD OF ', a6,
' *******' )
3170 9997
FORMAT(
' ******* XERBLA WAS CALLED WITH INFO = ', i6,
subroutine sspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
SSPR2
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 ssyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SSYR2
subroutine schk2(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G)
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine schk5(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, Z)
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
subroutine smake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
subroutine schk3(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, XT, G, Z)
subroutine schk1(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G)
subroutine smvch(TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV)
subroutine sgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGBMV
subroutine schke(ISNUM, SRNAMT, NOUT)
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine schk4(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, Z)
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine schk6(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, Z)
logical function lse(RI, RJ, LR)
subroutine stbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBMV
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine xerbla(SRNAME, INFO)
XERBLA
real function sdiff(SA, SB)
subroutine strsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRSV
subroutine stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPSV
real function sbeg(RESET)
subroutine stbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBSV
logical function lseres(TYPE, UPLO, M, N, AA, AS, LDA)
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR
subroutine sspr(UPLO, N, ALPHA, X, INCX, AP)
SSPR
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV