phynexis-deps/lapack
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

BLAS: count error-exit tests in the Level 2 and 3 drivers

Browse Source 
?CHKE reports only a pass/fail verdict per routine, with no indication
of how many error exits it checked. Report those counts too, in the same
shape as the computational ones:

     SGEMV      ERROR-EXIT TESTS:        6 RUN,        0 FAILED

One test is one CHKXER call. CHKXER is called between 96 and 229 times
per driver, so threading counters through its argument list is not an
option; they travel in a new /XERCNT/ block instead, following the
/INFOC/ and /SRNAMC/ pattern these files already use.

A test fails in two distinct ways. Either the routine never called
XERBLA, which CHKXER already detects through LERR; or XERBLA was called
with the wrong INFO or the wrong routine name, which clears OK inside
XERBLA without CHKXER ever noticing. The second case is not theoretical:
it is what the extended API drivers hit, where the BLAS reports SRNAME
as CGEMV_ against an expected CGEMV. NXBAD carries that across so the
counts agree with the verdict instead of reporting zero failures beside
a FAILED line.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
Simon Maertens
2026-07-29 11:24:03 +01:00
co-authored by Claude Opus 5
parent 447a75e381
commit ca1e0166df
8 changed files with 184 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
BLAS/TESTING/cblat2.f
+23
View File
@@ -2501,6 +2501,7 @@
INTEGER ISNUM, NOUT
CHARACTER*6 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Local Scalars ..
@@ -2514,6 +2515,7 @@
$ CTBSV, CTPMV, CTPSV, CTRMV, CTRSV
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2521,6 +2523,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
$ 90, 100, 110, 120, 130, 140, 150, 160,
$ 170 )ISNUM
@@ -2819,11 +2826,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
$ '**' )
9979 FORMAT( ' ', A6, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of CCHKE
*
@@ -3331,11 +3341,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*6 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3401,11 +3420,13 @@
INTEGER INFO
CHARACTER*6 SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*6 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Executable Statements ..
LERR = .TRUE.
@@ -3416,10 +3437,12 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
IF( SRNAME.NE.SRNAMT )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*
BLAS/TESTING/cblat3.f
+23
View File
@@ -2074,6 +2074,7 @@
INTEGER ISNUM, NOUT
CHARACTER*7 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Parameters ..
@@ -2089,6 +2090,7 @@
$ CSYR2K, CSYRK, CTRMM, CTRSM, CGEMMTR
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2096,6 +2098,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
*
* Initialize ALPHA, BETA, RALPHA, and RBETA.
*
@@ -3180,11 +3187,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****',
$ '**' )
9979 FORMAT( ' ', A7, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of CCHKE
*
@@ -3688,11 +3698,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*7 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3725,11 +3744,13 @@
INTEGER INFO
CHARACTER*(*) SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*7 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
@@ -3742,11 +3763,13 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*
BLAS/TESTING/dblat2.f
+23
View File
@@ -2494,6 +2494,7 @@
INTEGER ISNUM, NOUT
CHARACTER*10 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Local Scalars ..
@@ -2506,6 +2507,7 @@
$ DTPSV, DTRMV, DTRSV
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2513,6 +2515,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
$ 90, 100, 110, 120, 130, 140, 150,
$ 160, 170, 180 )ISNUM
@@ -2827,11 +2834,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A10, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A10, ' FAILED THE TESTS OF ERROR-EXITS ****',
$ '***' )
9979 FORMAT( ' ', A10, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of DCHKE
*
@@ -3313,11 +3323,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*10 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3383,11 +3402,13 @@
INTEGER INFO
CHARACTER*(*) SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*10 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
@@ -3400,11 +3421,13 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*
BLAS/TESTING/dblat3.f
+23
View File
@@ -1991,6 +1991,7 @@
INTEGER ISNUM, NOUT
CHARACTER*11 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Parameters ..
@@ -2005,6 +2006,7 @@
$ DTRSM, DGEMMTR
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2012,6 +2014,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
*
* Initialize ALPHA and BETA.
*
@@ -2729,11 +2736,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A11, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A11, ' FAILED THE TESTS OF ERROR-EXITS ****',
$ '***' )
9979 FORMAT( ' ', A11, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of DCHKE
*
@@ -3166,11 +3176,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*11 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3204,11 +3223,13 @@
INTEGER INFO
CHARACTER*(*) SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*11 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
@@ -3221,11 +3242,13 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*
BLAS/TESTING/sblat2.f
+23
View File
@@ -2494,6 +2494,7 @@
INTEGER ISNUM, NOUT
CHARACTER*10 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Local Scalars ..
@@ -2506,6 +2507,7 @@
$ STPSV, STRMV, STRSV
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2513,6 +2515,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
$ 90, 100, 110, 120, 130, 140, 150,
$ 160, 170, 180 )ISNUM
@@ -2827,11 +2834,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A10, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A10, ' FAILED THE TESTS OF ERROR-EXITS ****',
$ '***' )
9979 FORMAT( ' ', A10, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of SCHKE
*
@@ -3313,11 +3323,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*10 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3383,11 +3402,13 @@
INTEGER INFO
CHARACTER*(*) SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*10 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
@@ -3400,11 +3421,13 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*
BLAS/TESTING/sblat3.f
+23
View File
@@ -1992,6 +1992,7 @@
INTEGER ISNUM, NOUT
CHARACTER*11 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Parameters ..
@@ -2006,6 +2007,7 @@
$ STRSM, SGEMMTR
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2013,6 +2015,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
*
* Initialize ALPHA and BETA.
*
@@ -2730,11 +2737,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A11, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A11, ' FAILED THE TESTS OF ERROR-EXITS ****',
$ '***' )
9979 FORMAT( ' ', A11, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of SCHKE
*
@@ -3167,11 +3177,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*11 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3205,11 +3224,13 @@
INTEGER INFO
CHARACTER*(*) SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*11 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
@@ -3222,11 +3243,13 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*
BLAS/TESTING/zblat2.f
+23
View File
@@ -2507,6 +2507,7 @@
INTEGER ISNUM, NOUT
CHARACTER*6 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Local Scalars ..
@@ -2520,6 +2521,7 @@
$ ZTBSV, ZTPMV, ZTPSV, ZTRMV, ZTRSV
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2527,6 +2529,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
$ 90, 100, 110, 120, 130, 140, 150, 160,
$ 170 )ISNUM
@@ -2825,11 +2832,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
$ '**' )
9979 FORMAT( ' ', A6, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of ZCHKE
*
@@ -3338,11 +3348,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*6 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3408,11 +3427,13 @@
INTEGER INFO
CHARACTER*6 SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*6 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Executable Statements ..
LERR = .TRUE.
@@ -3423,10 +3444,12 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
IF( SRNAME.NE.SRNAMT )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*
BLAS/TESTING/zblat3.f
+23
View File
@@ -2080,6 +2080,7 @@
INTEGER ISNUM, NOUT
CHARACTER*7 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
* .. Parameters ..
@@ -2097,6 +2098,7 @@
INTRINSIC DCMPLX
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
* OK is set to .FALSE. by the special version of XERBLA or by CHKXER
* if anything is wrong.
@@ -2104,6 +2106,11 @@
* LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE.
* NXRUN and NXFAIL count the error-exit tests of this routine;
* NXBAD is set by XERBLA when it is called wrongly.
NXRUN = 0
NXFAIL = 0
NXBAD = 0
*
* Initialize ALPHA, BETA, RALPHA, and RBETA.
*
@@ -3188,11 +3195,14 @@
ELSE
WRITE( NOUT, FMT = 9998 )SRNAMT
END IF
WRITE( NOUT, FMT = 9979 )SRNAMT, NXRUN, NXFAIL
RETURN
*
9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' )
9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****',
$ '**' )
9979 FORMAT( ' ', A7, ' ERROR-EXIT TESTS:', I9, ' RUN,', I9,
$ ' FAILED' )
*
* End of ZCHKE
*
@@ -3699,11 +3709,20 @@
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*7 SRNAMT
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
* .. Common blocks ..
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
* .. Executable Statements ..
NXRUN = NXRUN + 1
IF( .NOT.LERR )THEN
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
OK = .FALSE.
NXFAIL = NXFAIL + 1
ELSE IF( NXBAD.NE.0 )THEN
NXFAIL = NXFAIL + 1
END IF
NXBAD = 0
LERR = .FALSE.
RETURN
*
@@ -3736,11 +3755,13 @@
INTEGER INFO
CHARACTER*(*) SRNAME
* .. Scalars in Common ..
INTEGER NXRUN, NXFAIL, NXBAD
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*7 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUT, OK, LERR
COMMON /XERCNT/NXRUN, NXFAIL, NXBAD
COMMON /SRNAMC/SRNAMT
* .. Locals ..
INTEGER SRLEN
@@ -3753,11 +3774,13 @@
WRITE( NOUT, FMT = 9997 )INFO
END IF
OK = .FALSE.
NXBAD = 1
END IF
SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
OK = .FALSE.
NXBAD = 1
END IF
RETURN
*