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 * =====================================================================
12 *
13 * .. Scalar Arguments ..
14 LOGICAL LERR, OK
15 CHARACTER*(*) SRNAMT
16 INTEGER INFOT, NOUT
17 * ..
18 * .. Intrinsic Functions ..
19 INTRINSIC LEN_TRIM
20 * ..
21 * .. Executable Statements ..
22 IF( .NOT.LERR ) THEN
23 WRITE( NOUT, FMT = 9999 )INFOT,
24 $ SRNAMT( 1:LEN_TRIM( SRNAMT ) )
25 OK = .FALSE.
26 END IF
27 LERR = .FALSE.
28 RETURN
29 *
30 9999 FORMAT( ' *** Illegal value of parameter number ', I2,
31 $ ' not detected by ', A6, ' ***' )
32 *
33 * End of CHKXER.
34 *
35 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 * =====================================================================
12 *
13 * .. Scalar Arguments ..
14 LOGICAL LERR, OK
15 CHARACTER*(*) SRNAMT
16 INTEGER INFOT, NOUT
17 * ..
18 * .. Intrinsic Functions ..
19 INTRINSIC LEN_TRIM
20 * ..
21 * .. Executable Statements ..
22 IF( .NOT.LERR ) THEN
23 WRITE( NOUT, FMT = 9999 )INFOT,
24 $ SRNAMT( 1:LEN_TRIM( SRNAMT ) )
25 OK = .FALSE.
26 END IF
27 LERR = .FALSE.
28 RETURN
29 *
30 9999 FORMAT( ' *** Illegal value of parameter number ', I2,
31 $ ' not detected by ', A6, ' ***' )
32 *
33 * End of CHKXER.
34 *
35 END