*DECK DCHKE2
SUBROUTINE DCHKE2 (ISNUM, SRNAMT, NOUT, KPRINT, FATAL)
C***BEGIN PROLOGUE DCHKE2
C***SUBSIDIARY
C***PURPOSE Test the error exits from the Level 2 Blas.
C***LIBRARY SLATEC (BLAS)
C***AUTHOR Du Croz, J. J., (NAG)
C Hanson, R. J., (SNLA)
C***DESCRIPTION
C
C Tests the error exits from the Level 2 Blas.
C ALPHA, BETA, A, X and Y should not need to be defined.
C
C Auxiliary routine for test program for Level 2 Blas.
C***REFERENCES (NONE)
C***ROUTINES CALLED CHKXER, DGBMV, DGEMV, DGER, DSBMV, DSPMV, DSPR,
C DSPR2, DSYMV, DSYR, DSYR2, DTBMV, DTBSV, DTPMV,
C DTPSV, DTRMV, DTRSV, XERCLR, XERDMP, XGETF, XSETF
C***REVISION HISTORY (YYMMDD)
C 870810 DATE WRITTEN
C 910620 Modified to meet SLATEC code and prologue standards. (BKS)
C***END PROLOGUE DCHKE2
C .. Scalar Arguments ..
INTEGER ISNUM, NOUT
LOGICAL FATAL
CHARACTER*6 SRNAMT
INTEGER INFOT, KPRINT
C .. Local Scalars ..
DOUBLE PRECISION ALPHA, BETA
INTEGER KONTRL
C .. Local Arrays ..
DOUBLE PRECISION A( 1, 1), X( 1), Y( 1)
C .. External Subroutines ..
EXTERNAL CHKXER, DGBMV, DGEMV, DGER, DSBMV, DSPMV, DSPR,
$ DSPR2, DSYMV, DSYR, DSYR2, DTBMV, DTBSV, DTPMV,
$ DTPSV, DTRMV, DTRSV
C***FIRST EXECUTABLE STATEMENT DCHKE2
CALL XGETF (KONTRL)
IF (KPRINT .LE. 2) THEN
CALL XSETF(0)
ELSE
CALL XSETF(1)
ENDIF
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
$ 90, 100, 110, 120, 130, 140, 150,
$ 160 )ISNUM
10 INFOT = 1
CALL XERCLR
CALL DGEMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DGEMV( 'N', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DGEMV( 'N', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 6
CALL XERCLR
CALL DGEMV( 'N', 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 8
CALL XERCLR
CALL DGEMV( 'N', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 11
CALL XERCLR
CALL DGEMV( 'N', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
20 INFOT = 1
CALL XERCLR
CALL DGBMV( '/', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DGBMV( 'N', -1, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DGBMV( 'N', 0, -1, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 4
CALL XERCLR
CALL DGBMV( 'N', 0, 0, -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DGBMV( 'N', 2, 0, 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 8
CALL XERCLR
CALL DGBMV( 'N', 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 10
CALL XERCLR
CALL DGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 13
CALL XERCLR
CALL DGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
30 INFOT = 1
CALL XERCLR
CALL DSYMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DSYMV( 'U', -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DSYMV( 'U', 2, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DSYMV( 'U', 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 10
CALL XERCLR
CALL DSYMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
40 INFOT = 1
CALL XERCLR
CALL DSBMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DSBMV( 'U', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DSBMV( 'U', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 6
CALL XERCLR
CALL DSBMV( 'U', 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 8
CALL XERCLR
CALL DSBMV( 'U', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 11
CALL XERCLR
CALL DSBMV( 'U', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
50 INFOT = 1
CALL XERCLR
CALL DSPMV( '/', 0, ALPHA, A, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DSPMV( 'U', -1, ALPHA, A, X, 1, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 6
CALL XERCLR
CALL DSPMV( 'U', 0, ALPHA, A, X, 0, BETA, Y, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 9
CALL XERCLR
CALL DSPMV( 'U', 0, ALPHA, A, X, 1, BETA, Y, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
60 INFOT = 1
CALL XERCLR
CALL DTRMV( '/', 'N', 'N', 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DTRMV( 'U', '/', 'N', 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DTRMV( 'U', 'N', '/', 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 4
CALL XERCLR
CALL DTRMV( 'U', 'N', 'N', -1, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 6
CALL XERCLR
CALL DTRMV( 'U', 'N', 'N', 2, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 8
CALL XERCLR
CALL DTRMV( 'U', 'N', 'N', 0, A, 1, X, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
70 INFOT = 1
CALL XERCLR
CALL DTBMV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DTBMV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DTBMV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 4
CALL XERCLR
CALL DTBMV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DTBMV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DTBMV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 9
CALL XERCLR
CALL DTBMV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
80 INFOT = 1
CALL XERCLR
CALL DTPMV( '/', 'N', 'N', 0, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DTPMV( 'U', '/', 'N', 0, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DTPMV( 'U', 'N', '/', 0, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 4
CALL XERCLR
CALL DTPMV( 'U', 'N', 'N', -1, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DTPMV( 'U', 'N', 'N', 0, A, X, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
90 INFOT = 1
CALL XERCLR
CALL DTRSV( '/', 'N', 'N', 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DTRSV( 'U', '/', 'N', 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DTRSV( 'U', 'N', '/', 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 4
CALL XERCLR
CALL DTRSV( 'U', 'N', 'N', -1, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 6
CALL XERCLR
CALL DTRSV( 'U', 'N', 'N', 2, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 8
CALL XERCLR
CALL DTRSV( 'U', 'N', 'N', 0, A, 1, X, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
100 INFOT = 1
CALL XERCLR
CALL DTBSV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DTBSV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DTBSV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 4
CALL XERCLR
CALL DTBSV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DTBSV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DTBSV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 9
CALL XERCLR
CALL DTBSV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
110 INFOT = 1
CALL XERCLR
CALL DTPSV( '/', 'N', 'N', 0, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DTPSV( 'U', '/', 'N', 0, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 3
CALL XERCLR
CALL DTPSV( 'U', 'N', '/', 0, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 4
CALL XERCLR
CALL DTPSV( 'U', 'N', 'N', -1, A, X, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DTPSV( 'U', 'N', 'N', 0, A, X, 0 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
120 INFOT = 1
CALL XERCLR
CALL DGER( -1, 0, ALPHA, X, 1, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DGER( 0, -1, ALPHA, X, 1, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DGER( 0, 0, ALPHA, X, 0, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DGER( 0, 0, ALPHA, X, 1, Y, 0, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 9
CALL XERCLR
CALL DGER( 2, 0, ALPHA, X, 1, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
130 INFOT = 1
CALL XERCLR
CALL DSYR( '/', 0, ALPHA, X, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DSYR( 'U', -1, ALPHA, X, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DSYR( 'U', 0, ALPHA, X, 0, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DSYR( 'U', 2, ALPHA, X, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
140 INFOT = 1
CALL XERCLR
CALL DSPR( '/', 0, ALPHA, X, 1, A )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DSPR( 'U', -1, ALPHA, X, 1, A )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DSPR( 'U', 0, ALPHA, X, 0, A )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
150 INFOT = 1
CALL XERCLR
CALL DSYR2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DSYR2( 'U', -1, ALPHA, X, 1, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DSYR2( 'U', 0, ALPHA, X, 0, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DSYR2( 'U', 0, ALPHA, X, 1, Y, 0, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 9
CALL XERCLR
CALL DSYR2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
GO TO 170
160 INFOT = 1
CALL XERCLR
CALL DSPR2( '/', 0, ALPHA, X, 1, Y, 1, A )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 2
CALL XERCLR
CALL DSPR2( 'U', -1, ALPHA, X, 1, Y, 1, A )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 5
CALL XERCLR
CALL DSPR2( 'U', 0, ALPHA, X, 0, Y, 1, A )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
INFOT = 7
CALL XERCLR
CALL DSPR2( 'U', 0, ALPHA, X, 1, Y, 0, A )
CALL CHKXER( SRNAMT, INFOT, NOUT, FATAL, KPRINT )
C
170 IF (KPRINT .GE. 2) THEN
CALL XERDMP
IF( .NOT.FATAL )THEN
WRITE( NOUT, FMT = 9999 )SRNAMT
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
ENDIF
CALL XSETF (KONTRL)
RETURN
C
9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
$ '**' )
C
C End of DCHKE2.
C
END