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( 1
x, 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( 1
x, i6,
': ', a6,
'(''', a1,
''',', 4( i3,
',' ), f4.1,
761 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
762 9994
FORMAT( 1
x, 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( 1
x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', AP',
1102 $
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
1103 9994
FORMAT( 1
x, i6,
': ', a6,
'(''', a1,
''',', 2( i3,
',' ), f4.1,
1104 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
1106 9993
FORMAT( 1
x, 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
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( 1
x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), i3,
', AP, ',
1461 9994
FORMAT( 1
x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), 2( i3,
',' ),
1462 $
' A,', i3,
', X,', i2,
') .' )
1463 9993
FORMAT( 1
x, 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
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( 1
x, 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
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( 1
x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2002 9993
FORMAT( 1
x, 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
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( 1
x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2316 $ i2,
', Y,', i2,
', AP) .' )
2317 9993
FORMAT( 1
x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2318 $ i2,
', Y,', i2,
', A,', i3,
') .' )
2319 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
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( 1
x, 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 ) )
3068 i = i - 1000*( i/1000 )
3073 sbeg =
REAL( i - 500 )/1001.0
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,
' *****' )
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 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 sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
subroutine schke(ISNUM, SRNAMT, NOUT)
REAL function sbeg(RESET)
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)
subroutine ssyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SSYR2
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
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)
REAL function sdiff(SA, SB)
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 sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
error code as a return value instead of the INFO parameter This implementation supports both the ILP64 and LP64 programming and different complex type C99 This implementation includes interfaces for the LAPACK Driver and Computational routines only Product Directories The installation directory of this package has the following compiler names for binaries to be created linked to You may choose the appropriate LP64 ILP64 convenient complex type LAPACKE name and or redefine system malloc free in make inc Several examples of make inc are provided After setting up the make inc
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
subroutine sgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGBMV
subroutine stbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBSV
subroutine ssbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSBMV
subroutine strsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRSV
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 stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPSV
LOGICAL function lse(RI, RJ, LR)
subroutine smake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR
subroutine sspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
SSPR2
subroutine sspr(UPLO, N, ALPHA, X, INCX, AP)
SSPR
subroutine smvch(TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV)
subroutine stbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBMV
LOGICAL function lseres(TYPE, UPLO, M, N, AA, AS, LDA)
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)