From f704b8d32f4cec59fab550f8dbf7e57ab0fd6865 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Villemot?= Date: Mon, 11 Jan 2016 11:15:33 +0100 Subject: [PATCH 1/2] Fix CBLAS double complex level 2 tests The SNAME variable contains names of C functions like "cblas_dgemv". Apparently the code was not taking into account the 6-letter "cblas_" prefix when determining the task to be done. The issue does not affect c_{s,d,c}blat2.f, which use the correct offsetting. Patch originally written by Camm Maguire. --- ctest/c_zblat2.f | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ctest/c_zblat2.f b/ctest/c_zblat2.f index 5a7d83ff4..439260230 100644 --- a/ctest/c_zblat2.f +++ b/ctest/c_zblat2.f @@ -1350,7 +1350,7 @@ * * Call the subroutine. * - IF( SNAME( 4: 5 ).EQ.'mv' )THEN + IF( SNAME( 10: 11 ).EQ.'mv' )THEN IF( FULL )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9993 )NC, SNAME, @@ -1376,7 +1376,7 @@ CALL CZTPMV( IORDER, UPLO, TRANS, DIAG, $ N, AA, XX, INCX ) END IF - ELSE IF( SNAME( 4: 5 ).EQ.'sv' )THEN + ELSE IF( SNAME( 10: 11 ).EQ.'sv' )THEN IF( FULL )THEN IF( TRACE ) $ WRITE( NTRA, FMT = 9993 )NC, SNAME, @@ -1465,7 +1465,7 @@ END IF * IF( .NOT.NULL )THEN - IF( SNAME( 4: 5 ).EQ.'mv' )THEN + IF( SNAME( 10: 11 ).EQ.'mv' )THEN * * Check the result. * @@ -1473,7 +1473,7 @@ $ INCX, ZERO, Z, INCX, XT, G, $ XX, EPS, ERR, FATAL, NOUT, $ .TRUE. ) - ELSE IF( SNAME( 4: 5 ).EQ.'sv' )THEN + ELSE IF( SNAME( 10: 11 ).EQ.'sv' )THEN * * Compute approximation to original vector. * @@ -1611,7 +1611,7 @@ * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK * .. Executable Statements .. - CONJ = SNAME( 5: 5 ).EQ.'c' + CONJ = SNAME( 11: 11 ).EQ.'c' * Define the number of arguments. NARGS = 9 * From 04ad946fc8f34dcf02dd00efb3120fad15d977fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Villemot?= Date: Mon, 11 Jan 2016 11:22:17 +0100 Subject: [PATCH 2/2] Fix output descriptors of c_{s,d,c,z}blat3 The NTRA argument can be equal to -1 if one does not want a snapshot file (and this is the case with sample data {s,d,c,z}in3). The routines {S,D,C,Z}PRCN3 will try to use their first argument as an output unit number, so we avoid calling them when NTRA < 0. Patch originally written by Camm Maguire. --- ctest/c_cblat3.f | 5 +++-- ctest/c_cblat3_3m.f | 5 +++-- ctest/c_dblat3.f | 5 +++-- ctest/c_sblat3.f | 5 +++-- ctest/c_zblat3.f | 5 +++-- ctest/c_zblat3_3m.f | 5 +++-- 6 files changed, 18 insertions(+), 12 deletions(-) diff --git a/ctest/c_cblat3.f b/ctest/c_cblat3.f index 7d1743b39..94144b875 100644 --- a/ctest/c_cblat3.f +++ b/ctest/c_cblat3.f @@ -1365,8 +1365,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL CPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL CPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/ctest/c_cblat3_3m.f b/ctest/c_cblat3_3m.f index 68dd49859..9643ebc89 100644 --- a/ctest/c_cblat3_3m.f +++ b/ctest/c_cblat3_3m.f @@ -1365,8 +1365,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL CPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL CPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/ctest/c_dblat3.f b/ctest/c_dblat3.f index 24befdc74..72ad80c92 100644 --- a/ctest/c_dblat3.f +++ b/ctest/c_dblat3.f @@ -1335,8 +1335,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL DPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL DPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/ctest/c_sblat3.f b/ctest/c_sblat3.f index 606f83a51..31babd9a1 100644 --- a/ctest/c_sblat3.f +++ b/ctest/c_sblat3.f @@ -1339,8 +1339,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL SPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL SPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/ctest/c_zblat3.f b/ctest/c_zblat3.f index 93b2b7736..21e743d17 100644 --- a/ctest/c_zblat3.f +++ b/ctest/c_zblat3.f @@ -1366,8 +1366,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL ZPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL ZPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN diff --git a/ctest/c_zblat3_3m.f b/ctest/c_zblat3_3m.f index 7390d8712..ead64da27 100644 --- a/ctest/c_zblat3_3m.f +++ b/ctest/c_zblat3_3m.f @@ -1366,8 +1366,9 @@ * 150 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - CALL ZPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, - $ M, N, ALPHA, LDA, LDB) + IF( TRACE ) + $ CALL ZPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, + $ M, N, ALPHA, LDA, LDB) * 160 CONTINUE RETURN