113 parameter( nsubs = 16 )
114 DOUBLE PRECISION zero, one
115 parameter( zero = 0.0d0, one = 1.0d0 )
117 parameter( nmax = 65, incmax = 2 )
118 INTEGER ninmax, nidmax, nkbmax, nalmax, nbemax
119 parameter( ninmax = 7, nidmax = 9, nkbmax = 7,
120 $ nalmax = 7, nbemax = 7 )
122 DOUBLE PRECISION eps, err, thresh
123 INTEGER i, isnum, j, n, nalf, nbet, nidim, ninc, nkb,
125 LOGICAL fatal, ltestt, rewi, same, sfatal, trace,
129 CHARACTER*32 snaps, summry
131 DOUBLE PRECISION a( nmax, nmax ), aa( nmax*nmax ),
132 $ alf( nalmax ), as( nmax*nmax ), bet( nbemax ),
133 $ g( nmax ), x( nmax ), xs( nmax*incmax ),
134 $ xx( nmax*incmax ), y( nmax ),
135 $ ys( nmax*incmax ), yt( nmax ),
136 $ yy( nmax*incmax ), z( 2*nmax )
137 INTEGER idim( nidmax ), inc( ninmax ), kb( nkbmax )
138 LOGICAL ltest( nsubs )
139 CHARACTER*6 snames( nsubs )
141 DOUBLE PRECISION ddiff
148 INTRINSIC abs, max, min
154 COMMON /infoc/infot, noutc, ok, lerr
155 COMMON /srnamc/srnamt
157 DATA snames/
'DGEMV ',
'DGBMV ',
'DSYMV ',
'DSBMV ',
158 $
'DSPMV ',
'DTRMV ',
'DTBMV ',
'DTPMV ',
159 $
'DTRSV ',
'DTBSV ',
'DTPSV ',
'DGER ',
160 $
'DSYR ',
'DSPR ',
'DSYR2 ',
'DSPR2 '/
165 READ( nin, fmt = * )summry
166 READ( nin, fmt = * )nout
167 OPEN( nout, file = summry, status =
'UNKNOWN' )
172 READ( nin, fmt = * )snaps
173 READ( nin, fmt = * )ntra
176 OPEN( ntra, file = snaps, status =
'UNKNOWN' )
179 READ( nin, fmt = * )rewi
180 rewi = rewi.AND.trace
182 READ( nin, fmt = * )sfatal
184 READ( nin, fmt = * )tsterr
186 READ( nin, fmt = * )thresh
191 READ( nin, fmt = * )nidim
192 IF( nidim.LT.1.OR.nidim.GT.nidmax )
THEN
193 WRITE( nout, fmt = 9997 )
'N', nidmax
196 READ( nin, fmt = * )( idim( i ), i = 1, nidim )
198 IF( idim( i ).LT.0.OR.idim( i ).GT.nmax )
THEN
199 WRITE( nout, fmt = 9996 )nmax
204 READ( nin, fmt = * )nkb
205 IF( nkb.LT.1.OR.nkb.GT.nkbmax )
THEN
206 WRITE( nout, fmt = 9997 )
'K', nkbmax
209 READ( nin, fmt = * )( kb( i ), i = 1, nkb )
211 IF( kb( i ).LT.0 )
THEN
212 WRITE( nout, fmt = 9995 )
217 READ( nin, fmt = * )ninc
218 IF( ninc.LT.1.OR.ninc.GT.ninmax )
THEN
219 WRITE( nout, fmt = 9997 )
'INCX AND INCY', ninmax
222 READ( nin, fmt = * )( inc( i ), i = 1, ninc )
224 IF( inc( i ).EQ.0.OR.abs( inc( i ) ).GT.incmax )
THEN
225 WRITE( nout, fmt = 9994 )incmax
230 READ( nin, fmt = * )nalf
231 IF( nalf.LT.1.OR.nalf.GT.nalmax )
THEN
232 WRITE( nout, fmt = 9997 )
'ALPHA', nalmax
235 READ( nin, fmt = * )( alf( i ), i = 1, nalf )
237 READ( nin, fmt = * )nbet
238 IF( nbet.LT.1.OR.nbet.GT.nbemax )
THEN
239 WRITE( nout, fmt = 9997 )
'BETA', nbemax
242 READ( nin, fmt = * )( bet( i ), i = 1, nbet )
246 WRITE( nout, fmt = 9993 )
247 WRITE( nout, fmt = 9992 )( idim( i ), i = 1, nidim )
248 WRITE( nout, fmt = 9991 )( kb( i ), i = 1, nkb )
249 WRITE( nout, fmt = 9990 )( inc( i ), i = 1, ninc )
250 WRITE( nout, fmt = 9989 )( alf( i ), i = 1, nalf )
251 WRITE( nout, fmt = 9988 )( bet( i ), i = 1, nbet )
252 IF( .NOT.tsterr )
THEN
253 WRITE( nout, fmt = * )
254 WRITE( nout, fmt = 9980 )
256 WRITE( nout, fmt = * )
257 WRITE( nout, fmt = 9999 )thresh
258 WRITE( nout, fmt = * )
266 50
READ( nin, fmt = 9984,
END = 80 )SNAMET, ltestt
268 IF( snamet.EQ.snames( i ) )
271 WRITE( nout, fmt = 9986 )snamet
273 70 ltest( i ) = ltestt
282 WRITE( nout, fmt = 9998 )eps
289 a( i, j ) = max( i - j + 1, 0 )
295 yy( j ) = j*( ( j + 1 )*j )/2 - ( ( j + 1 )*j*( j - 1 ) )/3
300 CALL dmvch( trans, n, n, one, a, nmax, x, 1, zero, y, 1, yt, g,
301 $ yy, eps, err, fatal, nout, .true. )
302 same =
lde( yy, yt, n )
303 IF( .NOT.same.OR.err.NE.zero )
THEN
304 WRITE( nout, fmt = 9985 )trans, same, err
308 CALL dmvch( trans, n, n, one, a, nmax, x, -1, zero, y, -1, yt, g,
309 $ yy, eps, err, fatal, nout, .true. )
310 same =
lde( yy, yt, n )
311 IF( .NOT.same.OR.err.NE.zero )
THEN
312 WRITE( nout, fmt = 9985 )trans, same, err
318 DO 210 isnum = 1, nsubs
319 WRITE( nout, fmt = * )
320 IF( .NOT.ltest( isnum ) )
THEN
322 WRITE( nout, fmt = 9983 )snames( isnum )
324 srnamt = snames( isnum )
327 CALL dchke( isnum, snames( isnum ), nout )
328 WRITE( nout, fmt = * )
334 GO TO ( 140, 140, 150, 150, 150, 160, 160,
335 $ 160, 160, 160, 160, 170, 180, 180,
338 140
CALL dchk1( snames( isnum ), eps, thresh, nout, ntra, trace,
339 $ rewi, fatal, nidim, idim, nkb, kb, nalf, alf,
340 $ nbet, bet, ninc, inc, nmax, incmax, a, aa, as,
341 $ x, xx, xs, y, yy, ys, yt, g )
344 150
CALL dchk2( snames( isnum ), eps, thresh, nout, ntra, trace,
345 $ rewi, fatal, nidim, idim, nkb, kb, nalf, alf,
346 $ nbet, bet, ninc, inc, nmax, incmax, a, aa, as,
347 $ x, xx, xs, y, yy, ys, yt, g )
351 160
CALL dchk3( snames( isnum ), eps, thresh, nout, ntra, trace,
352 $ rewi, fatal, nidim, idim, nkb, kb, ninc, inc,
353 $ nmax, incmax, a, aa, as, y, yy, ys, yt, g, z )
356 170
CALL dchk4( snames( isnum ), eps, thresh, nout, ntra, trace,
357 $ rewi, fatal, nidim, idim, nalf, alf, ninc, inc,
358 $ nmax, incmax, a, aa, as, x, xx, xs, y, yy, ys,
362 180
CALL dchk5( snames( isnum ), eps, thresh, nout, ntra, trace,
363 $ rewi, fatal, nidim, idim, nalf, alf, ninc, inc,
364 $ nmax, incmax, a, aa, as, x, xx, xs, y, yy, ys,
368 190
CALL dchk6( snames( isnum ), eps, thresh, nout, ntra, trace,
369 $ rewi, fatal, nidim, idim, nalf, alf, ninc, inc,
370 $ nmax, incmax, a, aa, as, x, xx, xs, y, yy, ys,
373 200
IF( fatal.AND.sfatal )
377 WRITE( nout, fmt = 9982 )
381 WRITE( nout, fmt = 9981 )
385 WRITE( nout, fmt = 9987 )
393 9999
FORMAT(
' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
395 9998
FORMAT(
' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1p, d9.1 )
396 9997
FORMAT(
' NUMBER OF VALUES OF ', a,
' IS LESS THAN 1 OR GREATER ',
398 9996
FORMAT(
' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', i2 )
399 9995
FORMAT(
' VALUE OF K IS LESS THAN 0' )
400 9994
FORMAT(
' ABSOLUTE VALUE OF INCX OR INCY IS 0 OR GREATER THAN ',
402 9993
FORMAT(
' TESTS OF THE DOUBLE PRECISION LEVEL 2 BLAS', //
' THE F',
403 $
'OLLOWING PARAMETER VALUES WILL BE USED:' )
404 9992
FORMAT(
' FOR N ', 9i6 )
405 9991
FORMAT(
' FOR K ', 7i6 )
406 9990
FORMAT(
' FOR INCX AND INCY ', 7i6 )
407 9989
FORMAT(
' FOR ALPHA ', 7f6.1 )
408 9988
FORMAT(
' FOR BETA ', 7f6.1 )
409 9987
FORMAT(
' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
410 $ /
' ******* TESTS ABANDONED *******' )
411 9986
FORMAT(
' SUBPROGRAM NAME ', a6,
' NOT RECOGNIZED', /
' ******* T',
412 $
'ESTS ABANDONED *******' )
413 9985
FORMAT(
' ERROR IN DMVCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
414 $
'ATED WRONGLY.', /
' DMVCH WAS CALLED WITH TRANS = ', a1,
415 $
' AND RETURNED SAME = ', l1,
' AND ERR = ', f12.3,
'.', /
416 $
' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.'
417 $ , /
' ******* TESTS ABANDONED *******' )
418 9984
FORMAT( a6, l2 )
419 9983
FORMAT( 1x, a6,
' WAS NOT TESTED' )
420 9982
FORMAT( /
' END OF TESTS' )
421 9981
FORMAT( /
' ******* FATAL ERROR - TESTS ABANDONED *******' )
422 9980
FORMAT(
' ERROR-EXITS WILL NOT BE TESTED' )
427 SUBROUTINE dchk1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
428 $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
429 $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
430 $ XS, Y, YY, YS, YT, G )
441 DOUBLE PRECISION ZERO, HALF
442 PARAMETER ( ZERO = 0.0d0, half = 0.5d0 )
444 DOUBLE PRECISION EPS, THRESH
445 INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
447 LOGICAL FATAL, REWI, TRACE
450 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
451 $ as( nmax*nmax ), bet( nbet ), g( nmax ),
452 $ x( nmax ), xs( nmax*incmax ),
453 $ xx( nmax*incmax ), y( nmax ),
454 $ ys( nmax*incmax ), yt( nmax ),
456 INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB )
458 DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL
459 INTEGER I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY,
460 $ INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA,
461 $ ldas, lx, ly, m, ml, ms, n, nargs, nc, nd, nk,
463 LOGICAL BANDED, FULL, NULL, RESET, SAME, TRAN
464 CHARACTER*1 TRANS, TRANSS
474 INTRINSIC abs, max, min
479 COMMON /infoc/infot, noutc, ok, lerr
483 full = sname( 3: 3 ).EQ.
'E'
484 banded = sname( 3: 3 ).EQ.
'B'
488 ELSE IF( banded )
THEN
502 $ m = max( n - nd, 0 )
504 $ m = min( n + nd, nmax )
514 kl = max( ku - 1, 0 )
531 null = n.LE.0.OR.m.LE.0
536 CALL dmake( sname( 2: 3 ),
' ',
' ', m, n, a, nmax, aa,
537 $ lda, kl, ku, reset, transl )
540 trans = ich( ic: ic )
541 tran = trans.EQ.
'T'.OR.trans.EQ.
'C'
558 CALL dmake(
'GE',
' ',
' ', 1, nl, x, 1, xx,
559 $ abs( incx ), 0, nl - 1, reset, transl )
562 xx( 1 + abs( incx )*( nl/2 - 1 ) ) = zero
578 CALL dmake(
'GE',
' ',
' ', 1, ml, y, 1,
579 $ yy, abs( incy ), 0, ml - 1,
611 $
WRITE( ntra, fmt = 9994 )nc, sname,
612 $ trans, m, n, alpha, lda, incx, beta,
616 CALL dgemv( trans, m, n, alpha, aa,
617 $ lda, xx, incx, beta, yy,
619 ELSE IF( banded )
THEN
621 $
WRITE( ntra, fmt = 9995 )nc, sname,
622 $ trans, m, n, kl, ku, alpha, lda,
626 CALL dgbmv( trans, m, n, kl, ku, alpha,
627 $ aa, lda, xx, incx, beta,
634 WRITE( nout, fmt = 9993 )
641 isame( 1 ) = trans.EQ.transs
645 isame( 4 ) = als.EQ.alpha
646 isame( 5 ) = lde( as, aa, laa )
647 isame( 6 ) = ldas.EQ.lda
648 isame( 7 ) = lde( xs, xx, lx )
649 isame( 8 ) = incxs.EQ.incx
650 isame( 9 ) = bls.EQ.beta
652 isame( 10 ) = lde( ys, yy, ly )
654 isame( 10 ) = lderes(
'GE',
' ', 1,
658 isame( 11 ) = incys.EQ.incy
659 ELSE IF( banded )
THEN
660 isame( 4 ) = kls.EQ.kl
661 isame( 5 ) = kus.EQ.ku
662 isame( 6 ) = als.EQ.alpha
663 isame( 7 ) = lde( as, aa, laa )
664 isame( 8 ) = ldas.EQ.lda
665 isame( 9 ) = lde( xs, xx, lx )
666 isame( 10 ) = incxs.EQ.incx
667 isame( 11 ) = bls.EQ.beta
669 isame( 12 ) = lde( ys, yy, ly )
671 isame( 12 ) = lderes(
'GE',
' ', 1,
675 isame( 13 ) = incys.EQ.incy
683 same = same.AND.isame( i )
684 IF( .NOT.isame( i ) )
685 $
WRITE( nout, fmt = 9998 )i
696 CALL dmvch( trans, m, n, alpha, a,
697 $ nmax, x, incx, beta, y,
698 $ incy, yt, g, yy, eps, err,
699 $ fatal, nout, .true. )
700 errmax = max( errmax, err )
729 IF( errmax.LT.thresh )
THEN
730 WRITE( nout, fmt = 9999 )sname, nc
732 WRITE( nout, fmt = 9997 )sname, nc, errmax
737 WRITE( nout, fmt = 9996 )sname
739 WRITE( nout, fmt = 9994 )nc, sname, trans, m, n, alpha, lda,
741 ELSE IF( banded )
THEN
742 WRITE( nout, fmt = 9995 )nc, sname, trans, m, n, kl, ku,
743 $ alpha, lda, incx, beta, incy
749 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
751 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
752 $
'ANGED INCORRECTLY *******' )
753 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
754 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
755 $
' - SUSPECT *******' )
756 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
757 9995
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', 4( i3,
',' ), f4.1,
758 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
759 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', 2( i3,
',' ), f4.1,
760 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
762 9993
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
768 SUBROUTINE dchk2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
769 $ FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
770 $ BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
771 $ XS, Y, YY, YS, YT, G )
782 DOUBLE PRECISION ZERO, HALF
783 PARAMETER ( ZERO = 0.0d0, half = 0.5d0 )
785 DOUBLE PRECISION EPS, THRESH
786 INTEGER INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
788 LOGICAL FATAL, REWI, TRACE
791 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
792 $ as( nmax*nmax ), bet( nbet ), g( nmax ),
793 $ x( nmax ), xs( nmax*incmax ),
794 $ xx( nmax*incmax ), y( nmax ),
795 $ ys( nmax*incmax ), yt( nmax ),
797 INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB )
799 DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL
800 INTEGER I, IA, IB, IC, IK, IN, INCX, INCXS, INCY,
801 $ INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY,
802 $ N, NARGS, NC, NK, NS
803 LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME
804 CHARACTER*1 UPLO, UPLOS
819 COMMON /infoc/infot, noutc, ok, lerr
823 full = sname( 3: 3 ).EQ.
'Y'
824 banded = sname( 3: 3 ).EQ.
'B'
825 packed = sname( 3: 3 ).EQ.
'P'
829 ELSE IF( banded )
THEN
831 ELSE IF( packed )
THEN
865 laa = ( n*( n + 1 ) )/2
877 CALL dmake( sname( 2: 3 ), uplo,
' ', n, n, a, nmax, aa,
878 $ lda, k, k, reset, transl )
887 CALL dmake(
'GE',
' ',
' ', 1, n, x, 1, xx,
888 $ abs( incx ), 0, n - 1, reset, transl )
891 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
907 CALL dmake(
'GE',
' ',
' ', 1, n, y, 1, yy,
908 $ abs( incy ), 0, n - 1, reset,
938 $
WRITE( ntra, fmt = 9993 )nc, sname,
939 $ uplo, n, alpha, lda, incx, beta, incy
942 CALL dsymv( uplo, n, alpha, aa, lda, xx,
943 $ incx, beta, yy, incy )
944 ELSE IF( banded )
THEN
946 $
WRITE( ntra, fmt = 9994 )nc, sname,
947 $ uplo, n, k, alpha, lda, incx, beta,
951 CALL dsbmv( uplo, n, k, alpha, aa, lda,
952 $ xx, incx, beta, yy, incy )
953 ELSE IF( packed )
THEN
955 $
WRITE( ntra, fmt = 9995 )nc, sname,
956 $ uplo, n, alpha, incx, beta, incy
959 CALL dspmv( uplo, n, alpha, aa, xx, incx,
966 WRITE( nout, fmt = 9992 )
973 isame( 1 ) = uplo.EQ.uplos
976 isame( 3 ) = als.EQ.alpha
977 isame( 4 ) = lde( as, aa, laa )
978 isame( 5 ) = ldas.EQ.lda
979 isame( 6 ) = lde( xs, xx, lx )
980 isame( 7 ) = incxs.EQ.incx
981 isame( 8 ) = bls.EQ.beta
983 isame( 9 ) = lde( ys, yy, ly )
985 isame( 9 ) = lderes(
'GE',
' ', 1, n,
986 $ ys, yy, abs( incy ) )
988 isame( 10 ) = incys.EQ.incy
989 ELSE IF( banded )
THEN
991 isame( 4 ) = als.EQ.alpha
992 isame( 5 ) = lde( as, aa, laa )
993 isame( 6 ) = ldas.EQ.lda
994 isame( 7 ) = lde( xs, xx, lx )
995 isame( 8 ) = incxs.EQ.incx
996 isame( 9 ) = bls.EQ.beta
998 isame( 10 ) = lde( ys, yy, ly )
1000 isame( 10 ) = lderes(
'GE',
' ', 1, n,
1001 $ ys, yy, abs( incy ) )
1003 isame( 11 ) = incys.EQ.incy
1004 ELSE IF( packed )
THEN
1005 isame( 3 ) = als.EQ.alpha
1006 isame( 4 ) = lde( as, aa, laa )
1007 isame( 5 ) = lde( xs, xx, lx )
1008 isame( 6 ) = incxs.EQ.incx
1009 isame( 7 ) = bls.EQ.beta
1011 isame( 8 ) = lde( ys, yy, ly )
1013 isame( 8 ) = lderes(
'GE',
' ', 1, n,
1014 $ ys, yy, abs( incy ) )
1016 isame( 9 ) = incys.EQ.incy
1024 same = same.AND.isame( i )
1025 IF( .NOT.isame( i ) )
1026 $
WRITE( nout, fmt = 9998 )i
1037 CALL dmvch(
'N', n, n, alpha, a, nmax, x,
1038 $ incx, beta, y, incy, yt, g,
1039 $ yy, eps, err, fatal, nout,
1041 errmax = max( errmax, err )
1067 IF( errmax.LT.thresh )
THEN
1068 WRITE( nout, fmt = 9999 )sname, nc
1070 WRITE( nout, fmt = 9997 )sname, nc, errmax
1075 WRITE( nout, fmt = 9996 )sname
1077 WRITE( nout, fmt = 9993 )nc, sname, uplo, n, alpha, lda, incx,
1079 ELSE IF( banded )
THEN
1080 WRITE( nout, fmt = 9994 )nc, sname, uplo, n, k, alpha, lda,
1082 ELSE IF( packed )
THEN
1083 WRITE( nout, fmt = 9995 )nc, sname, uplo, n, alpha, incx,
1090 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1092 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1093 $
'ANGED INCORRECTLY *******' )
1094 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1095 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1096 $
' - SUSPECT *******' )
1097 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1098 9995
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', AP',
1099 $
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
1100 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', 2( i3,
',' ), f4.1,
1101 $
', A,', i3,
', X,', i2,
',', f4.1,
', Y,', i2,
1103 9993
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', A,',
1104 $ i3,
', X,', i2,
',', f4.1,
', Y,', i2,
') .' )
1105 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1111 SUBROUTINE dchk3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1112 $ FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX,
1113 $ INCMAX, A, AA, AS, X, XX, XS, XT, G, Z )
1124 DOUBLE PRECISION ZERO, HALF, ONE
1125 PARAMETER ( ZERO = 0.0d0, half = 0.5d0, one = 1.0d0 )
1127 DOUBLE PRECISION EPS, THRESH
1128 INTEGER INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA
1129 LOGICAL FATAL, REWI, TRACE
1132 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ),
1133 $ as( nmax*nmax ), g( nmax ), x( nmax ),
1134 $ xs( nmax*incmax ), xt( nmax ),
1135 $ xx( nmax*incmax ), z( nmax )
1136 INTEGER IDIM( NIDIM ), INC( NINC ), KB( NKB )
1138 DOUBLE PRECISION ERR, ERRMAX, TRANSL
1139 INTEGER I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K,
1140 $ ks, laa, lda, ldas, lx, n, nargs, nc, nk, ns
1141 LOGICAL BANDED, FULL, NULL, PACKED, RESET, SAME
1142 CHARACTER*1 DIAG, DIAGS, TRANS, TRANSS, UPLO, UPLOS
1143 CHARACTER*2 ICHD, ICHU
1149 EXTERNAL lde, lderes
1156 INTEGER INFOT, NOUTC
1159 COMMON /infoc/infot, noutc, ok, lerr
1161 DATA ichu/
'UL'/, icht/
'NTC'/, ichd/
'UN'/
1163 full = sname( 3: 3 ).EQ.
'R'
1164 banded = sname( 3: 3 ).EQ.
'B'
1165 packed = sname( 3: 3 ).EQ.
'P'
1169 ELSE IF( banded )
THEN
1171 ELSE IF( packed )
THEN
1183 DO 110 in = 1, nidim
1209 laa = ( n*( n + 1 ) )/2
1216 uplo = ichu( icu: icu )
1219 trans = icht( ict: ict )
1222 diag = ichd( icd: icd )
1227 CALL dmake( sname( 2: 3 ), uplo, diag, n, n, a,
1228 $ nmax, aa, lda, k, k, reset, transl )
1237 CALL dmake(
'GE',
' ',
' ', 1, n, x, 1, xx,
1238 $ abs( incx ), 0, n - 1, reset,
1242 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
1265 IF( sname( 4: 5 ).EQ.
'MV' )
THEN
1268 $
WRITE( ntra, fmt = 9993 )nc, sname,
1269 $ uplo, trans, diag, n, lda, incx
1272 CALL dtrmv( uplo, trans, diag, n, aa, lda,
1274 ELSE IF( banded )
THEN
1276 $
WRITE( ntra, fmt = 9994 )nc, sname,
1277 $ uplo, trans, diag, n, k, lda, incx
1280 CALL dtbmv( uplo, trans, diag, n, k, aa,
1282 ELSE IF( packed )
THEN
1284 $
WRITE( ntra, fmt = 9995 )nc, sname,
1285 $ uplo, trans, diag, n, incx
1288 CALL dtpmv( uplo, trans, diag, n, aa, xx,
1291 ELSE IF( sname( 4: 5 ).EQ.
'SV' )
THEN
1294 $
WRITE( ntra, fmt = 9993 )nc, sname,
1295 $ uplo, trans, diag, n, lda, incx
1298 CALL dtrsv( uplo, trans, diag, n, aa, lda,
1300 ELSE IF( banded )
THEN
1302 $
WRITE( ntra, fmt = 9994 )nc, sname,
1303 $ uplo, trans, diag, n, k, lda, incx
1306 CALL dtbsv( uplo, trans, diag, n, k, aa,
1308 ELSE IF( packed )
THEN
1310 $
WRITE( ntra, fmt = 9995 )nc, sname,
1311 $ uplo, trans, diag, n, incx
1314 CALL dtpsv( uplo, trans, diag, n, aa, xx,
1322 WRITE( nout, fmt = 9992 )
1329 isame( 1 ) = uplo.EQ.uplos
1330 isame( 2 ) = trans.EQ.transs
1331 isame( 3 ) = diag.EQ.diags
1332 isame( 4 ) = ns.EQ.n
1334 isame( 5 ) = lde( as, aa, laa )
1335 isame( 6 ) = ldas.EQ.lda
1337 isame( 7 ) = lde( xs, xx, lx )
1339 isame( 7 ) = lderes(
'GE',
' ', 1, n, xs,
1342 isame( 8 ) = incxs.EQ.incx
1343 ELSE IF( banded )
THEN
1344 isame( 5 ) = ks.EQ.k
1345 isame( 6 ) = lde( as, aa, laa )
1346 isame( 7 ) = ldas.EQ.lda
1348 isame( 8 ) = lde( xs, xx, lx )
1350 isame( 8 ) = lderes(
'GE',
' ', 1, n, xs,
1353 isame( 9 ) = incxs.EQ.incx
1354 ELSE IF( packed )
THEN
1355 isame( 5 ) = lde( as, aa, laa )
1357 isame( 6 ) = lde( xs, xx, lx )
1359 isame( 6 ) = lderes(
'GE',
' ', 1, n, xs,
1362 isame( 7 ) = incxs.EQ.incx
1370 same = same.AND.isame( i )
1371 IF( .NOT.isame( i ) )
1372 $
WRITE( nout, fmt = 9998 )i
1380 IF( sname( 4: 5 ).EQ.
'MV' )
THEN
1384 CALL dmvch( trans, n, n, one, a, nmax, x,
1385 $ incx, zero, z, incx, xt, g,
1386 $ xx, eps, err, fatal, nout,
1388 ELSE IF( sname( 4: 5 ).EQ.
'SV' )
THEN
1393 z( i ) = xx( 1 + ( i - 1 )*
1395 xx( 1 + ( i - 1 )*abs( incx ) )
1398 CALL dmvch( trans, n, n, one, a, nmax, z,
1399 $ incx, zero, x, incx, xt, g,
1400 $ xx, eps, err, fatal, nout,
1403 errmax = max( errmax, err )
1426 IF( errmax.LT.thresh )
THEN
1427 WRITE( nout, fmt = 9999 )sname, nc
1429 WRITE( nout, fmt = 9997 )sname, nc, errmax
1434 WRITE( nout, fmt = 9996 )sname
1436 WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, diag, n, lda,
1438 ELSE IF( banded )
THEN
1439 WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, diag, n, k,
1441 ELSE IF( packed )
THEN
1442 WRITE( nout, fmt = 9995 )nc, sname, uplo, trans, diag, n, incx
1448 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1450 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1451 $
'ANGED INCORRECTLY *******' )
1452 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1453 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1454 $
' - SUSPECT *******' )
1455 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1456 9995
FORMAT( 1x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), i3,
', AP, ',
1458 9994
FORMAT( 1x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), 2( i3,
',' ),
1459 $
' A,', i3,
', X,', i2,
') .' )
1460 9993
FORMAT( 1x, i6,
': ', a6,
'(', 3(
'''', a1,
''',' ), i3,
', A,',
1461 $ i3,
', X,', i2,
') .' )
1462 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1468 SUBROUTINE dchk4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1469 $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
1470 $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
1482 DOUBLE PRECISION ZERO, HALF, ONE
1483 PARAMETER ( ZERO = 0.0d0, half = 0.5d0, one = 1.0d0 )
1485 DOUBLE PRECISION EPS, THRESH
1486 INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
1487 LOGICAL FATAL, REWI, TRACE
1490 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
1491 $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
1492 $ XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
1493 $ y( nmax ), ys( nmax*incmax ), yt( nmax ),
1494 $ yy( nmax*incmax ), z( nmax )
1495 INTEGER IDIM( NIDIM ), INC( NINC )
1497 DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL
1498 INTEGER I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX,
1499 $ iy, j, laa, lda, ldas, lx, ly, m, ms, n, nargs,
1501 LOGICAL NULL, RESET, SAME
1503 DOUBLE PRECISION W( 1 )
1507 EXTERNAL LDE, LDERES
1511 INTRINSIC abs, max, min
1513 INTEGER INFOT, NOUTC
1516 COMMON /infoc/infot, noutc, ok, lerr
1525 DO 120 in = 1, nidim
1531 $ m = max( n - nd, 0 )
1533 $ m = min( n + nd, nmax )
1543 null = n.LE.0.OR.m.LE.0
1552 CALL dmake(
'GE',
' ',
' ', 1, m, x, 1, xx, abs( incx ),
1553 $ 0, m - 1, reset, transl )
1556 xx( 1 + abs( incx )*( m/2 - 1 ) ) = zero
1566 CALL dmake(
'GE',
' ',
' ', 1, n, y, 1, yy,
1567 $ abs( incy ), 0, n - 1, reset, transl )
1570 yy( 1 + abs( incy )*( n/2 - 1 ) ) = zero
1579 CALL dmake( sname( 2: 3 ),
' ',
' ', m, n, a, nmax,
1580 $ aa, lda, m - 1, n - 1, reset, transl )
1605 $
WRITE( ntra, fmt = 9994 )nc, sname, m, n,
1606 $ alpha, incx, incy, lda
1609 CALL dger( m, n, alpha, xx, incx, yy, incy, aa,
1615 WRITE( nout, fmt = 9993 )
1622 isame( 1 ) = ms.EQ.m
1623 isame( 2 ) = ns.EQ.n
1624 isame( 3 ) = als.EQ.alpha
1625 isame( 4 ) = lde( xs, xx, lx )
1626 isame( 5 ) = incxs.EQ.incx
1627 isame( 6 ) = lde( ys, yy, ly )
1628 isame( 7 ) = incys.EQ.incy
1630 isame( 8 ) = lde( as, aa, laa )
1632 isame( 8 ) = lderes(
'GE',
' ', m, n, as, aa,
1635 isame( 9 ) = ldas.EQ.lda
1641 same = same.AND.isame( i )
1642 IF( .NOT.isame( i ) )
1643 $
WRITE( nout, fmt = 9998 )i
1660 z( i ) = x( m - i + 1 )
1667 w( 1 ) = y( n - j + 1 )
1669 CALL dmvch(
'N', m, 1, alpha, z, nmax, w, 1,
1670 $ one, a( 1, j ), 1, yt, g,
1671 $ aa( 1 + ( j - 1 )*lda ), eps,
1672 $ err, fatal, nout, .true. )
1673 errmax = max( errmax, err )
1695 IF( errmax.LT.thresh )
THEN
1696 WRITE( nout, fmt = 9999 )sname, nc
1698 WRITE( nout, fmt = 9997 )sname, nc, errmax
1703 WRITE( nout, fmt = 9995 )j
1706 WRITE( nout, fmt = 9996 )sname
1707 WRITE( nout, fmt = 9994 )nc, sname, m, n, alpha, incx, incy, lda
1712 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1714 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1715 $
'ANGED INCORRECTLY *******' )
1716 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1717 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1718 $
' - SUSPECT *******' )
1719 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1720 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1721 9994
FORMAT( 1x, i6,
': ', a6,
'(', 2( i3,
',' ), f4.1,
', X,', i2,
1722 $
', Y,', i2,
', A,', i3,
') .' )
1723 9993
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1729 SUBROUTINE dchk5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1730 $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
1731 $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
1743 DOUBLE PRECISION ZERO, HALF, ONE
1744 PARAMETER ( ZERO = 0.0d0, half = 0.5d0, one = 1.0d0 )
1746 DOUBLE PRECISION EPS, THRESH
1747 INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
1748 LOGICAL FATAL, REWI, TRACE
1751 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
1752 $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
1753 $ XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
1754 $ Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
1755 $ YY( NMAX*INCMAX ), Z( NMAX )
1756 INTEGER IDIM( NIDIM ), INC( NINC )
1758 DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL
1759 INTEGER I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA,
1760 $ lda, ldas, lj, lx, n, nargs, nc, ns
1761 LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER
1762 CHARACTER*1 UPLO, UPLOS
1765 DOUBLE PRECISION W( 1 )
1769 EXTERNAL LDE, LDERES
1775 INTEGER INFOT, NOUTC
1778 COMMON /infoc/infot, noutc, ok, lerr
1782 full = sname( 3: 3 ).EQ.
'Y'
1783 packed = sname( 3: 3 ).EQ.
'P'
1787 ELSE IF( packed )
THEN
1795 DO 100 in = 1, nidim
1805 laa = ( n*( n + 1 ) )/2
1811 uplo = ich( ic: ic )
1821 CALL dmake(
'GE',
' ',
' ', 1, n, x, 1, xx, abs( incx ),
1822 $ 0, n - 1, reset, transl )
1825 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
1830 null = n.LE.0.OR.alpha.EQ.zero
1835 CALL dmake( sname( 2: 3 ), uplo,
' ', n, n, a, nmax,
1836 $ aa, lda, n - 1, n - 1, reset, transl )
1858 $
WRITE( ntra, fmt = 9993 )nc, sname, uplo, n,
1862 CALL dsyr( uplo, n, alpha, xx, incx, aa, lda )
1863 ELSE IF( packed )
THEN
1865 $
WRITE( ntra, fmt = 9994 )nc, sname, uplo, n,
1869 CALL dspr( uplo, n, alpha, xx, incx, aa )
1875 WRITE( nout, fmt = 9992 )
1882 isame( 1 ) = uplo.EQ.uplos
1883 isame( 2 ) = ns.EQ.n
1884 isame( 3 ) = als.EQ.alpha
1885 isame( 4 ) = lde( xs, xx, lx )
1886 isame( 5 ) = incxs.EQ.incx
1888 isame( 6 ) = lde( as, aa, laa )
1890 isame( 6 ) = lderes( sname( 2: 3 ), uplo, n, n, as,
1893 IF( .NOT.packed )
THEN
1894 isame( 7 ) = ldas.EQ.lda
1901 same = same.AND.isame( i )
1902 IF( .NOT.isame( i ) )
1903 $
WRITE( nout, fmt = 9998 )i
1920 z( i ) = x( n - i + 1 )
1933 CALL dmvch(
'N', lj, 1, alpha, z( jj ), lj, w,
1934 $ 1, one, a( jj, j ), 1, yt, g,
1935 $ aa( ja ), eps, err, fatal, nout,
1946 errmax = max( errmax, err )
1967 IF( errmax.LT.thresh )
THEN
1968 WRITE( nout, fmt = 9999 )sname, nc
1970 WRITE( nout, fmt = 9997 )sname, nc, errmax
1975 WRITE( nout, fmt = 9995 )j
1978 WRITE( nout, fmt = 9996 )sname
1980 WRITE( nout, fmt = 9993 )nc, sname, uplo, n, alpha, incx, lda
1981 ELSE IF( packed )
THEN
1982 WRITE( nout, fmt = 9994 )nc, sname, uplo, n, alpha, incx
1988 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1990 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1991 $
'ANGED INCORRECTLY *******' )
1992 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1993 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1994 $
' - SUSPECT *******' )
1995 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1996 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1997 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
1999 9993
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2000 $ i2,
', A,', i3,
') .' )
2001 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
2007 SUBROUTINE dchk6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
2008 $ FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
2009 $ INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
2021 DOUBLE PRECISION ZERO, HALF, ONE
2022 PARAMETER ( ZERO = 0.0d0, half = 0.5d0, one = 1.0d0 )
2024 DOUBLE PRECISION EPS, THRESH
2025 INTEGER INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
2026 LOGICAL FATAL, REWI, TRACE
2029 DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
2030 $ AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
2031 $ XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
2032 $ Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
2033 $ YY( NMAX*INCMAX ), Z( NMAX, 2 )
2034 INTEGER IDIM( NIDIM ), INC( NINC )
2036 DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX, TRANSL
2037 INTEGER I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX,
2038 $ iy, j, ja, jj, laa, lda, ldas, lj, lx, ly, n,
2040 LOGICAL FULL, NULL, PACKED, RESET, SAME, UPPER
2041 CHARACTER*1 UPLO, UPLOS
2044 DOUBLE PRECISION W( 2 )
2048 EXTERNAL LDE, LDERES
2050 EXTERNAL DMAKE, DMVCH, DSPR2, DSYR2
2054 INTEGER INFOT, NOUTC
2057 COMMON /infoc/infot, noutc, ok, lerr
2061 full = sname( 3: 3 ).EQ.
'Y'
2062 packed = sname( 3: 3 ).EQ.
'P'
2066 ELSE IF( packed )
THEN
2074 DO 140 in = 1, nidim
2084 laa = ( n*( n + 1 ) )/2
2090 uplo = ich( ic: ic )
2100 CALL dmake(
'GE',
' ',
' ', 1, n, x, 1, xx, abs( incx ),
2101 $ 0, n - 1, reset, transl )
2104 xx( 1 + abs( incx )*( n/2 - 1 ) ) = zero
2114 CALL dmake(
'GE',
' ',
' ', 1, n, y, 1, yy,
2115 $ abs( incy ), 0, n - 1, reset, transl )
2118 yy( 1 + abs( incy )*( n/2 - 1 ) ) = zero
2123 null = n.LE.0.OR.alpha.EQ.zero
2128 CALL dmake( sname( 2: 3 ), uplo,
' ', n, n, a,
2129 $ nmax, aa, lda, n - 1, n - 1, reset,
2156 $
WRITE( ntra, fmt = 9993 )nc, sname, uplo, n,
2157 $ alpha, incx, incy, lda
2160 CALL dsyr2( uplo, n, alpha, xx, incx, yy, incy,
2162 ELSE IF( packed )
THEN
2164 $
WRITE( ntra, fmt = 9994 )nc, sname, uplo, n,
2168 CALL dspr2( uplo, n, alpha, xx, incx, yy, incy,
2175 WRITE( nout, fmt = 9992 )
2182 isame( 1 ) = uplo.EQ.uplos
2183 isame( 2 ) = ns.EQ.n
2184 isame( 3 ) = als.EQ.alpha
2185 isame( 4 ) = lde( xs, xx, lx )
2186 isame( 5 ) = incxs.EQ.incx
2187 isame( 6 ) = lde( ys, yy, ly )
2188 isame( 7 ) = incys.EQ.incy
2190 isame( 8 ) = lde( as, aa, laa )
2192 isame( 8 ) = lderes( sname( 2: 3 ), uplo, n, n,
2195 IF( .NOT.packed )
THEN
2196 isame( 9 ) = ldas.EQ.lda
2203 same = same.AND.isame( i )
2204 IF( .NOT.isame( i ) )
2205 $
WRITE( nout, fmt = 9998 )i
2222 z( i, 1 ) = x( n - i + 1 )
2231 z( i, 2 ) = y( n - i + 1 )
2245 CALL dmvch(
'N', lj, 2, alpha, z( jj, 1 ),
2246 $ nmax, w, 1, one, a( jj, j ), 1,
2247 $ yt, g, aa( ja ), eps, err, fatal,
2258 errmax = max( errmax, err )
2281 IF( errmax.LT.thresh )
THEN
2282 WRITE( nout, fmt = 9999 )sname, nc
2284 WRITE( nout, fmt = 9997 )sname, nc, errmax
2289 WRITE( nout, fmt = 9995 )j
2292 WRITE( nout, fmt = 9996 )sname
2294 WRITE( nout, fmt = 9993 )nc, sname, uplo, n, alpha, incx,
2296 ELSE IF( packed )
THEN
2297 WRITE( nout, fmt = 9994 )nc, sname, uplo, n, alpha, incx, incy
2303 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
2305 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
2306 $
'ANGED INCORRECTLY *******' )
2307 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
2308 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
2309 $
' - SUSPECT *******' )
2310 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
2311 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
2312 9994
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2313 $ i2,
', Y,', i2,
', AP) .' )
2314 9993
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',', i3,
',', f4.1,
', X,',
2315 $ i2,
', Y,', i2,
', A,', i3,
') .' )
2316 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
2338 INTEGER INFOT, NOUTC
2341 DOUBLE PRECISION ALPHA, BETA
2343 DOUBLE PRECISION A( 1, 1 ), X( 1 ), Y( 1 )
2345 EXTERNAL CHKXER, DGBMV, DGEMV, DGER, DSBMV, DSPMV, DSPR,
2346 $ DSPR2, DSYMV, DSYR, DSYR2, DTBMV, DTBSV, DTPMV,
2347 $ DTPSV, DTRMV, DTRSV
2349 COMMON /INFOC/INFOT, NOUTC, OK, LERR
2357 GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
2358 $ 90, 100, 110, 120, 130, 140, 150,
2361 CALL dgemv(
'/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2362 CALL chkxer( srnamt, infot, nout, lerr, ok )
2364 CALL dgemv(
'N', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2365 CALL chkxer( srnamt, infot, nout, lerr, ok )
2367 CALL dgemv(
'N', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2368 CALL chkxer( srnamt, infot, nout, lerr, ok )
2370 CALL dgemv(
'N', 2, 0, alpha, a, 1, x, 1, beta, y, 1 )
2371 CALL chkxer( srnamt, infot, nout, lerr, ok )
2373 CALL dgemv(
'N', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2374 CALL chkxer( srnamt, infot, nout, lerr, ok )
2376 CALL dgemv(
'N', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2377 CALL chkxer( srnamt, infot, nout, lerr, ok )
2380 CALL dgbmv(
'/', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2381 CALL chkxer( srnamt, infot, nout, lerr, ok )
2383 CALL dgbmv(
'N', -1, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2384 CALL chkxer( srnamt, infot, nout, lerr, ok )
2386 CALL dgbmv(
'N', 0, -1, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2387 CALL chkxer( srnamt, infot, nout, lerr, ok )
2389 CALL dgbmv(
'N', 0, 0, -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2390 CALL chkxer( srnamt, infot, nout, lerr, ok )
2392 CALL dgbmv(
'N', 2, 0, 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2393 CALL chkxer( srnamt, infot, nout, lerr, ok )
2395 CALL dgbmv(
'N', 0, 0, 1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2396 CALL chkxer( srnamt, infot, nout, lerr, ok )
2398 CALL dgbmv(
'N', 0, 0, 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2399 CALL chkxer( srnamt, infot, nout, lerr, ok )
2401 CALL dgbmv(
'N', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2402 CALL chkxer( srnamt, infot, nout, lerr, ok )
2405 CALL dsymv(
'/', 0, alpha, a, 1, x, 1, beta, y, 1 )
2406 CALL chkxer( srnamt, infot, nout, lerr, ok )
2408 CALL dsymv(
'U', -1, alpha, a, 1, x, 1, beta, y, 1 )
2409 CALL chkxer( srnamt, infot, nout, lerr, ok )
2411 CALL dsymv(
'U', 2, alpha, a, 1, x, 1, beta, y, 1 )
2412 CALL chkxer( srnamt, infot, nout, lerr, ok )
2414 CALL dsymv(
'U', 0, alpha, a, 1, x, 0, beta, y, 1 )
2415 CALL chkxer( srnamt, infot, nout, lerr, ok )
2417 CALL dsymv(
'U', 0, alpha, a, 1, x, 1, beta, y, 0 )
2418 CALL chkxer( srnamt, infot, nout, lerr, ok )
2421 CALL dsbmv(
'/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2422 CALL chkxer( srnamt, infot, nout, lerr, ok )
2424 CALL dsbmv(
'U', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2425 CALL chkxer( srnamt, infot, nout, lerr, ok )
2427 CALL dsbmv(
'U', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2428 CALL chkxer( srnamt, infot, nout, lerr, ok )
2430 CALL dsbmv(
'U', 0, 1, alpha, a, 1, x, 1, beta, y, 1 )
2431 CALL chkxer( srnamt, infot, nout, lerr, ok )
2433 CALL dsbmv(
'U', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2434 CALL chkxer( srnamt, infot, nout, lerr, ok )
2436 CALL dsbmv(
'U', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2437 CALL chkxer( srnamt, infot, nout, lerr, ok )
2440 CALL dspmv(
'/', 0, alpha, a, x, 1, beta, y, 1 )
2441 CALL chkxer( srnamt, infot, nout, lerr, ok )
2443 CALL dspmv(
'U', -1, alpha, a, x, 1, beta, y, 1 )
2444 CALL chkxer( srnamt, infot, nout, lerr, ok )
2446 CALL dspmv(
'U', 0, alpha, a, x, 0, beta, y, 1 )
2447 CALL chkxer( srnamt, infot, nout, lerr, ok )
2449 CALL dspmv(
'U', 0, alpha, a, x, 1, beta, y, 0 )
2450 CALL chkxer( srnamt, infot, nout, lerr, ok )
2453 CALL dtrmv(
'/',
'N',
'N', 0, a, 1, x, 1 )
2454 CALL chkxer( srnamt, infot, nout, lerr, ok )
2456 CALL dtrmv(
'U',
'/',
'N', 0, a, 1, x, 1 )
2457 CALL chkxer( srnamt, infot, nout, lerr, ok )
2459 CALL dtrmv(
'U',
'N',
'/', 0, a, 1, x, 1 )
2460 CALL chkxer( srnamt, infot, nout, lerr, ok )
2462 CALL dtrmv(
'U',
'N',
'N', -1, a, 1, x, 1 )
2463 CALL chkxer( srnamt, infot, nout, lerr, ok )
2465 CALL dtrmv(
'U',
'N',
'N', 2, a, 1, x, 1 )
2466 CALL chkxer( srnamt, infot, nout, lerr, ok )
2468 CALL dtrmv(
'U',
'N',
'N', 0, a, 1, x, 0 )
2469 CALL chkxer( srnamt, infot, nout, lerr, ok )
2472 CALL dtbmv(
'/',
'N',
'N', 0, 0, a, 1, x, 1 )
2473 CALL chkxer( srnamt, infot, nout, lerr, ok )
2475 CALL dtbmv(
'U',
'/',
'N', 0, 0, a, 1, x, 1 )
2476 CALL chkxer( srnamt, infot, nout, lerr, ok )
2478 CALL dtbmv(
'U',
'N',
'/', 0, 0, a, 1, x, 1 )
2479 CALL chkxer( srnamt, infot, nout, lerr, ok )
2481 CALL dtbmv(
'U',
'N',
'N', -1, 0, a, 1, x, 1 )
2482 CALL chkxer( srnamt, infot, nout, lerr, ok )
2484 CALL dtbmv(
'U',
'N',
'N', 0, -1, a, 1, x, 1 )
2485 CALL chkxer( srnamt, infot, nout, lerr, ok )
2487 CALL dtbmv(
'U',
'N',
'N', 0, 1, a, 1, x, 1 )
2488 CALL chkxer( srnamt, infot, nout, lerr, ok )
2490 CALL dtbmv(
'U',
'N',
'N', 0, 0, a, 1, x, 0 )
2491 CALL chkxer( srnamt, infot, nout, lerr, ok )
2494 CALL dtpmv(
'/',
'N',
'N', 0, a, x, 1 )
2495 CALL chkxer( srnamt, infot, nout, lerr, ok )
2497 CALL dtpmv(
'U',
'/',
'N', 0, a, x, 1 )
2498 CALL chkxer( srnamt, infot, nout, lerr, ok )
2500 CALL dtpmv(
'U',
'N',
'/', 0, a, x, 1 )
2501 CALL chkxer( srnamt, infot, nout, lerr, ok )
2503 CALL dtpmv(
'U',
'N',
'N', -1, a, x, 1 )
2504 CALL chkxer( srnamt, infot, nout, lerr, ok )
2506 CALL dtpmv(
'U',
'N',
'N', 0, a, x, 0 )
2507 CALL chkxer( srnamt, infot, nout, lerr, ok )
2510 CALL dtrsv(
'/',
'N',
'N', 0, a, 1, x, 1 )
2511 CALL chkxer( srnamt, infot, nout, lerr, ok )
2513 CALL dtrsv(
'U',
'/',
'N', 0, a, 1, x, 1 )
2514 CALL chkxer( srnamt, infot, nout, lerr, ok )
2516 CALL dtrsv(
'U',
'N',
'/', 0, a, 1, x, 1 )
2517 CALL chkxer( srnamt, infot, nout, lerr, ok )
2519 CALL dtrsv(
'U',
'N',
'N', -1, a, 1, x, 1 )
2520 CALL chkxer( srnamt, infot, nout, lerr, ok )
2522 CALL dtrsv(
'U',
'N',
'N', 2, a, 1, x, 1 )
2523 CALL chkxer( srnamt, infot, nout, lerr, ok )
2525 CALL dtrsv(
'U',
'N',
'N', 0, a, 1, x, 0 )
2526 CALL chkxer( srnamt, infot, nout, lerr, ok )
2529 CALL dtbsv(
'/',
'N',
'N', 0, 0, a, 1, x, 1 )
2530 CALL chkxer( srnamt, infot, nout, lerr, ok )
2532 CALL dtbsv(
'U',
'/',
'N', 0, 0, a, 1, x, 1 )
2533 CALL chkxer( srnamt, infot, nout, lerr, ok )
2535 CALL dtbsv(
'U',
'N',
'/', 0, 0, a, 1, x, 1 )
2536 CALL chkxer( srnamt, infot, nout, lerr, ok )
2538 CALL dtbsv(
'U',
'N',
'N', -1, 0, a, 1, x, 1 )
2539 CALL chkxer( srnamt, infot, nout, lerr, ok )
2541 CALL dtbsv(
'U',
'N',
'N', 0, -1, a, 1, x, 1 )
2542 CALL chkxer( srnamt, infot, nout, lerr, ok )
2544 CALL dtbsv(
'U',
'N',
'N', 0, 1, a, 1, x, 1 )
2545 CALL chkxer( srnamt, infot, nout, lerr, ok )
2547 CALL dtbsv(
'U',
'N',
'N', 0, 0, a, 1, x, 0 )
2548 CALL chkxer( srnamt, infot, nout, lerr, ok )
2551 CALL dtpsv(
'/',
'N',
'N', 0, a, x, 1 )
2552 CALL chkxer( srnamt, infot, nout, lerr, ok )
2554 CALL dtpsv(
'U',
'/',
'N', 0, a, x, 1 )
2555 CALL chkxer( srnamt, infot, nout, lerr, ok )
2557 CALL dtpsv(
'U',
'N',
'/', 0, a, x, 1 )
2558 CALL chkxer( srnamt, infot, nout, lerr, ok )
2560 CALL dtpsv(
'U',
'N',
'N', -1, a, x, 1 )
2561 CALL chkxer( srnamt, infot, nout, lerr, ok )
2563 CALL dtpsv(
'U',
'N',
'N', 0, a, x, 0 )
2564 CALL chkxer( srnamt, infot, nout, lerr, ok )
2567 CALL dger( -1, 0, alpha, x, 1, y, 1, a, 1 )
2568 CALL chkxer( srnamt, infot, nout, lerr, ok )
2570 CALL dger( 0, -1, alpha, x, 1, y, 1, a, 1 )
2571 CALL chkxer( srnamt, infot, nout, lerr, ok )
2573 CALL dger( 0, 0, alpha, x, 0, y, 1, a, 1 )
2574 CALL chkxer( srnamt, infot, nout, lerr, ok )
2576 CALL dger( 0, 0, alpha, x, 1, y, 0, a, 1 )
2577 CALL chkxer( srnamt, infot, nout, lerr, ok )
2579 CALL dger( 2, 0, alpha, x, 1, y, 1, a, 1 )
2580 CALL chkxer( srnamt, infot, nout, lerr, ok )
2583 CALL dsyr(
'/', 0, alpha, x, 1, a, 1 )
2584 CALL chkxer( srnamt, infot, nout, lerr, ok )
2586 CALL dsyr(
'U', -1, alpha, x, 1, a, 1 )
2587 CALL chkxer( srnamt, infot, nout, lerr, ok )
2589 CALL dsyr(
'U', 0, alpha, x, 0, a, 1 )
2590 CALL chkxer( srnamt, infot, nout, lerr, ok )
2592 CALL dsyr(
'U', 2, alpha, x, 1, a, 1 )
2593 CALL chkxer( srnamt, infot, nout, lerr, ok )
2596 CALL dspr(
'/', 0, alpha, x, 1, a )
2597 CALL chkxer( srnamt, infot, nout, lerr, ok )
2599 CALL dspr(
'U', -1, alpha, x, 1, a )
2600 CALL chkxer( srnamt, infot, nout, lerr, ok )
2602 CALL dspr(
'U', 0, alpha, x, 0, a )
2603 CALL chkxer( srnamt, infot, nout, lerr, ok )
2606 CALL dsyr2(
'/', 0, alpha, x, 1, y, 1, a, 1 )
2607 CALL chkxer( srnamt, infot, nout, lerr, ok )
2609 CALL dsyr2(
'U', -1, alpha, x, 1, y, 1, a, 1 )
2610 CALL chkxer( srnamt, infot, nout, lerr, ok )
2612 CALL dsyr2(
'U', 0, alpha, x, 0, y, 1, a, 1 )
2613 CALL chkxer( srnamt, infot, nout, lerr, ok )
2615 CALL dsyr2(
'U', 0, alpha, x, 1, y, 0, a, 1 )
2616 CALL chkxer( srnamt, infot, nout, lerr, ok )
2618 CALL dsyr2(
'U', 2, alpha, x, 1, y, 1, a, 1 )
2619 CALL chkxer( srnamt, infot, nout, lerr, ok )
2622 CALL dspr2(
'/', 0, alpha, x, 1, y, 1, a )
2623 CALL chkxer( srnamt, infot, nout, lerr, ok )
2625 CALL dspr2(
'U', -1, alpha, x, 1, y, 1, a )
2626 CALL chkxer( srnamt, infot, nout, lerr, ok )
2628 CALL dspr2(
'U', 0, alpha, x, 0, y, 1, a )
2629 CALL chkxer( srnamt, infot, nout, lerr, ok )
2631 CALL dspr2(
'U', 0, alpha, x, 1, y, 0, a )
2632 CALL chkxer( srnamt, infot, nout, lerr, ok )
2635 WRITE( nout, fmt = 9999 )srnamt
2637 WRITE( nout, fmt = 9998 )srnamt
2641 9999
FORMAT(
' ', a6,
' PASSED THE TESTS OF ERROR-EXITS' )
2642 9998
FORMAT(
' ******* ', a6,
' FAILED THE TESTS OF ERROR-EXITS *****',
2648 SUBROUTINE dmake( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL,
2649 $ KU, RESET, TRANSL )
2665 DOUBLE PRECISION ZERO, ONE
2666 parameter( zero = 0.0d0, one = 1.0d0 )
2667 DOUBLE PRECISION ROGUE
2668 PARAMETER ( ROGUE = -1.0d10 )
2670 DOUBLE PRECISION TRANSL
2671 INTEGER KL, KU, LDA, M, N, NMAX
2673 CHARACTER*1 DIAG, UPLO
2676 DOUBLE PRECISION A( NMAX, * ), AA( * )
2678 INTEGER I, I1, I2, I3, IBEG, IEND, IOFF, J, KK
2679 LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER
2681 DOUBLE PRECISION DBEG
2686 gen =
TYPE( 1: 1 ).EQ.
'G'
2687 SYM = type( 1: 1 ).EQ.
'S'
2688 tri =
TYPE( 1: 1 ).EQ.
'T'
2689 upper = ( sym.OR.tri ).AND.uplo.EQ.
'U'
2690 lower = ( sym.OR.tri ).AND.uplo.EQ.
'L'
2691 unit = tri.AND.diag.EQ.
'U'
2697 IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2699 IF( ( i.LE.j.AND.j - i.LE.ku ).OR.
2700 $ ( i.GE.j.AND.i - j.LE.kl ) )
THEN
2701 a( i, j ) = dbeg( reset ) + transl
2707 a( j, i ) = a( i, j )
2715 $ a( j, j ) = a( j, j ) + one
2722 IF( type.EQ.
'GE' )
THEN
2725 aa( i + ( j - 1 )*lda ) = a( i, j )
2727 DO 40 i = m + 1, lda
2728 aa( i + ( j - 1 )*lda ) = rogue
2731 ELSE IF( type.EQ.
'GB' )
THEN
2733 DO 60 i1 = 1, ku + 1 - j
2734 aa( i1 + ( j - 1 )*lda ) = rogue
2736 DO 70 i2 = i1, min( kl + ku + 1, ku + 1 + m - j )
2737 aa( i2 + ( j - 1 )*lda ) = a( i2 + j - ku - 1, j )
2740 aa( i3 + ( j - 1 )*lda ) = rogue
2743 ELSE IF( type.EQ.
'SY'.OR.type.EQ.
'TR' )
THEN
2760 DO 100 i = 1, ibeg - 1
2761 aa( i + ( j - 1 )*lda ) = rogue
2763 DO 110 i = ibeg, iend
2764 aa( i + ( j - 1 )*lda ) = a( i, j )
2766 DO 120 i = iend + 1, lda
2767 aa( i + ( j - 1 )*lda ) = rogue
2770 ELSE IF( type.EQ.
'SB'.OR.type.EQ.
'TB' )
THEN
2774 ibeg = max( 1, kl + 2 - j )
2787 iend = min( kl + 1, 1 + m - j )
2789 DO 140 i = 1, ibeg - 1
2790 aa( i + ( j - 1 )*lda ) = rogue
2792 DO 150 i = ibeg, iend
2793 aa( i + ( j - 1 )*lda ) = a( i + j - kk, j )
2795 DO 160 i = iend + 1, lda
2796 aa( i + ( j - 1 )*lda ) = rogue
2799 ELSE IF( type.EQ.
'SP'.OR.type.EQ.
'TP' )
THEN
2809 DO 180 i = ibeg, iend
2811 aa( ioff ) = a( i, j )
2814 $ aa( ioff ) = rogue
2824 SUBROUTINE dmvch( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y,
2825 $ INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV )
2836 DOUBLE PRECISION ZERO, ONE
2837 parameter( zero = 0.0d0, one = 1.0d0 )
2839 DOUBLE PRECISION ALPHA, BETA, EPS, ERR
2840 INTEGER INCX, INCY, M, N, NMAX, NOUT
2844 DOUBLE PRECISION A( NMAX, * ), G( * ), X( * ), Y( * ), YT( * ),
2847 DOUBLE PRECISION ERRI
2848 INTEGER I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
2851 INTRINSIC ABS, MAX, SQRT
2853 TRAN = trans.EQ.
'T'.OR.trans.EQ.
'C'
2886 yt( iy ) = yt( iy ) + a( j, i )*x( jx )
2887 g( iy ) = g( iy ) + abs( a( j, i )*x( jx ) )
2892 yt( iy ) = yt( iy ) + a( i, j )*x( jx )
2893 g( iy ) = g( iy ) + abs( a( i, j )*x( jx ) )
2897 yt( iy ) = alpha*yt( iy ) + beta*y( iy )
2898 g( iy ) = abs( alpha )*g( iy ) + abs( beta*y( iy ) )
2906 erri = abs( yt( i ) - yy( 1 + ( i - 1 )*abs( incy ) ) )/eps
2907 IF( g( i ).NE.zero )
2908 $ erri = erri/g( i )
2909 err = max( err, erri )
2910 IF( err*sqrt( eps ).GE.one )
2919 WRITE( nout, fmt = 9999 )
2922 WRITE( nout, fmt = 9998 )i, yt( i ),
2923 $ yy( 1 + ( i - 1 )*abs( incy ) )
2925 WRITE( nout, fmt = 9998 )i,
2926 $ yy( 1 + ( i - 1 )*abs( incy ) ), yt( i )
2933 9999
FORMAT(
' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
2934 $
'F ACCURATE *******', /
' EXPECTED RESULT COMPU',
2936 9998
FORMAT( 1x, i7, 2g18.6 )
2941 LOGICAL FUNCTION lde( RI, RJ, LR )
2954 DOUBLE PRECISION ri( * ), rj( * )
2959 IF( ri( i ).NE.rj( i ) )
2971 LOGICAL FUNCTION lderes( TYPE, UPLO, M, N, AA, AS, LDA )
2988 DOUBLE PRECISION aa( lda, * ), as( lda, * )
2990 INTEGER i, ibeg, iend, j
2994 IF( type.EQ.
'GE' )
THEN
2996 DO 10 i = m + 1, lda
2997 IF( aa( i, j ).NE.as( i, j ) )
3001 ELSE IF( type.EQ.
'SY' )
THEN
3010 DO 30 i = 1, ibeg - 1
3011 IF( aa( i, j ).NE.as( i, j ) )
3014 DO 40 i = iend + 1, lda
3015 IF( aa( i, j ).NE.as( i, j ) )
3030 DOUBLE PRECISION FUNCTION dbeg( RESET )
3065 i = i - 1000*( i/1000 )
3070 dbeg = dble( i - 500 )/1001.0d0
3084 DOUBLE PRECISION x, y
3092 SUBROUTINE chkxer( SRNAMT, INFOT, NOUT, LERR, OK )
3108 WRITE( nout, fmt = 9999 )infot, srnamt
3114 9999
FORMAT(
' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', i2,
' NOT D',
3115 $
'ETECTED BY ', a6,
' *****' )
3145 COMMON /INFOC/INFOT, NOUT, OK, LERR
3146 COMMON /SRNAMC/SRNAMT
3149 IF( info.NE.infot )
THEN
3150 IF( infot.NE.0 )
THEN
3151 WRITE( nout, fmt = 9999 )info, infot
3153 WRITE( nout, fmt = 9997 )info
3157 IF( srname.NE.srnamt )
THEN
3158 WRITE( nout, fmt = 9998 )srname, srnamt
3163 9999
FORMAT(
' ******* XERBLA WAS CALLED WITH INFO = ', i6,
' INSTEAD',
3164 $
' OF ', i2,
' *******' )
3165 9998
FORMAT(
' ******* XERBLA WAS CALLED WITH SRNAME = ', a6,
' INSTE',
3166 $
'AD OF ', a6,
' *******' )
3167 9997
FORMAT(
' ******* XERBLA WAS CALLED WITH INFO = ', i6,
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
double precision function dbeg(RESET)
subroutine dmake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
subroutine dchk2(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)
double precision function ddiff(X, Y)
logical function lde(RI, RJ, LR)
subroutine dchk3(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 dchke(ISNUM, SRNAMT, NOUT)
logical function lderes(TYPE, UPLO, M, N, AA, AS, LDA)
subroutine dchk5(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 dchk4(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 dchk1(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 dchk6(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 dmvch(TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y, INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV)
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRSV
subroutine dgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGBMV
subroutine dtpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPSV
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPMV
subroutine dspr(UPLO, N, ALPHA, X, INCX, AP)
DSPR
subroutine dsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
DSYR
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRMV
subroutine dsbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DSBMV
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DSYMV
subroutine dtbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBSV
subroutine dtbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBMV
subroutine dspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
DSPMV
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV