diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index 60b0f39134..09be46e4e5 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } void F77_c2chke(char *rout @@ -52,7 +51,7 @@ void F77_c2chke(char *rout F77_xerbla(cblas_rout,&cblas_info, 1); } #endif - + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index 97318d8e8b..05109d4e0a 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } void F77_c3chke(char * rout @@ -56,6 +55,7 @@ void F77_c3chke(char * rout } #endif + link_xerbla = 0; if (strncmp( sf,"cblas_cgemmtr" ,13)==0) { cblas_rout = "cblas_cgemmtr" ; diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index 1ac5147b0b..9e9d981107 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } void F77_d2chke(char *rout @@ -51,6 +50,7 @@ void F77_d2chke(char *rout } #endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index 98e2c030e3..fa611f0f20 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } void F77_d3chke(char *rout @@ -51,6 +50,7 @@ void F77_d3chke(char *rout } #endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; diff --git a/CBLAS/testing/c_dblat3.f b/CBLAS/testing/c_dblat3.f index e88a77dc7b..ee1b818f40 100644 --- a/CBLAS/testing/c_dblat3.f +++ b/CBLAS/testing/c_dblat3.f @@ -84,10 +84,10 @@ PROGRAM DBLAT3 INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK CHARACTER*13 SRNAMT * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'cblas_dgemm ', 'cblas_dsymm ', @@ -365,14 +365,14 @@ PROGRAM DBLAT3 185 IF (CORDER) THEN CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, - $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 0 ) END IF IF (RORDER) THEN CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, - $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 1 ) END IF GO TO 190 @@ -478,9 +478,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICH/'NTC'/ * .. Executable Statements .. @@ -802,9 +802,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHS/'LR'/, ICHU/'UL'/ * .. Executable Statements .. @@ -1113,9 +1113,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/ * .. Executable Statements .. @@ -1472,9 +1472,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. @@ -1789,9 +1789,9 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index ff7756a6b3..81d4c2104e 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } void F77_s2chke(char *rout @@ -51,6 +50,7 @@ void F77_s2chke(char *rout } #endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index 871f8a66d5..38b2bc1a3c 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } @@ -52,6 +51,7 @@ void F77_s3chke(char *rout } #endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; diff --git a/CBLAS/testing/c_sblat3.f b/CBLAS/testing/c_sblat3.f index c6f6961900..85270aef7b 100644 --- a/CBLAS/testing/c_sblat3.f +++ b/CBLAS/testing/c_sblat3.f @@ -85,10 +85,10 @@ PROGRAM SBLAT3 INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK CHARACTER*13 SRNAMT * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'cblas_sgemm ', 'cblas_ssymm ', @@ -365,15 +365,14 @@ PROGRAM SBLAT3 185 IF (CORDER) THEN CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, - $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) - + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 0 ) END IF IF (RORDER) THEN CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, - $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 1 ) END IF GO TO 190 * @@ -480,9 +479,9 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICH/'NTC'/ * .. Executable Statements .. @@ -808,9 +807,9 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHS/'LR'/, ICHU/'UL'/ * .. Executable Statements .. @@ -1119,9 +1118,9 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/ * .. Executable Statements .. @@ -1479,9 +1478,9 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. @@ -1796,9 +1795,9 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, INTRINSIC MAX * .. Scalars in Common .. INTEGER INFOT, NOUTC - LOGICAL OK + LOGICAL LERR, OK * .. Common blocks .. - COMMON /INFOC/INFOT, NOUTC, OK + COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Data statements .. DATA ICHT/'NTC'/, ICHU/'UL'/ * .. Executable Statements .. diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index 6816052e75..2b88a39d67 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -103,7 +103,7 @@ void F77_xerbla(char *srname, void *vinfo char *srname; #endif - char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0'}; + char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0', '\0'}; #ifdef F77_Integer F77_Integer *info=vinfo; @@ -124,8 +124,12 @@ void F77_xerbla(char *srname, void *vinfo link_xerbla = 0; return; } - for(i=0; i < 7; i++) rout[i+6] = tolower(srname[i]); - for(i=12; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0'; +#ifndef BLAS_FORTRAN_STRLEN_END + const int srname_len = 6; +#endif + + for(i=0; i < srname_len; i++) rout[i+6] = tolower(srname[i]); + for(i=13; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0'; /* We increment *info by 1 since the CBLAS interface adds one more * argument to all level 2 and 3 routines. diff --git a/CBLAS/testing/c_z2chke.c b/CBLAS/testing/c_z2chke.c index 08de99d07d..f86c483c2a 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } void F77_z2chke(char *rout @@ -53,6 +52,7 @@ void F77_z2chke(char *rout } #endif + link_xerbla = 0; cblas_ok = TRUE ; cblas_lerr = PASSED ; diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index 0ebbfb3498..44febcaff8 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -26,7 +26,6 @@ void chkxer(void) { cblas_ok = 0 ; } cblas_lerr = 1 ; - link_xerbla = TRUE; } void F77_z3chke(char *rout @@ -55,6 +54,8 @@ void F77_z3chke(char *rout F77_xerbla(cblas_rout,&cblas_info, 1); } #endif + + link_xerbla = 0; if (strncmp( sf,"cblas_zgemmtr" ,13)==0) { cblas_rout = "cblas_zgemmtr" ;