1 SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
2 *
3 * Tests whether XERBLA has detected an error when it should.
4 *
5 * Auxiliary routine for test program for Level 2 Blas.
6 *
7 * -- Written on 10-August-1987.
8 * Richard Hanson, Sandia National Labs.
9 * Jeremy Du Croz, NAG Central Office.
10 *
11 * .. Scalar Arguments ..
12 LOGICAL LERR, OK
13 CHARACTER*(*) SRNAMT
14 INTEGER INFOT, NOUT
15 * ..
16 * .. Intrinsic Functions ..
17 INTRINSIC LEN_TRIM
18 * ..
19 * .. Executable Statements ..
20 IF( .NOT.LERR ) THEN
21 WRITE( NOUT, FMT = 9999 )INFOT,
22 $ SRNAMT( 1:LEN_TRIM( SRNAMT ) )
23 OK = .FALSE.
24 END IF
25 LERR = .FALSE.
26 RETURN
27 *
28 9999 FORMAT( ' *** Illegal value of parameter number ', I2,
29 $ ' not detected by ', A6, ' ***' )
30 *
31 * End of CHKXER.
32 *
33 END
2 *
3 * Tests whether XERBLA has detected an error when it should.
4 *
5 * Auxiliary routine for test program for Level 2 Blas.
6 *
7 * -- Written on 10-August-1987.
8 * Richard Hanson, Sandia National Labs.
9 * Jeremy Du Croz, NAG Central Office.
10 *
11 * .. Scalar Arguments ..
12 LOGICAL LERR, OK
13 CHARACTER*(*) SRNAMT
14 INTEGER INFOT, NOUT
15 * ..
16 * .. Intrinsic Functions ..
17 INTRINSIC LEN_TRIM
18 * ..
19 * .. Executable Statements ..
20 IF( .NOT.LERR ) THEN
21 WRITE( NOUT, FMT = 9999 )INFOT,
22 $ SRNAMT( 1:LEN_TRIM( SRNAMT ) )
23 OK = .FALSE.
24 END IF
25 LERR = .FALSE.
26 RETURN
27 *
28 9999 FORMAT( ' *** Illegal value of parameter number ', I2,
29 $ ' not detected by ', A6, ' ***' )
30 *
31 * End of CHKXER.
32 *
33 END