diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt index 3a087bea7..497ee3f9e 100644 --- a/TESTING/LIN/CMakeLists.txt +++ b/TESTING/LIN/CMakeLists.txt @@ -222,10 +222,12 @@ else() endif() # Disable constant propagation for NAG compiler to avoid issues with -# creating NaN values in the CXX error-exit tests. +# creating NaN values in the CXX error-exit tests and in the NaN pivot +# checks of the packed symmetric-indefinite tests. if(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") set_source_files_properties( serrcxx.f cerrcxx.f derrcxx.f zerrcxx.f + schksp.f cchksp.f dchksp.f zchksp.f cchkhp.f zchkhp.f PROPERTIES COMPILE_OPTIONS "-Onopropagate") endif() @@ -277,11 +279,12 @@ function(add_lin_executable name) generate_64bit_suffixed_sources(${name} ext_sources ext_sources_64) # Disable constant propagation for NAG compiler to avoid issues with - # creating NaN values in the CXX error-exit tests. + # creating NaN values in the CXX error-exit tests and in the NaN + # pivot checks of the packed symmetric-indefinite tests. if(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") foreach(source IN LISTS ext_sources_64) get_filename_component(source_name "${source}" NAME) - if(source_name MATCHES "^[scdz]errcxx_64\\.f$") + if(source_name MATCHES "^[scdz](errcxx|chksp|chkhp)_64\\.f$") set_source_files_properties( "${source}" PROPERTIES COMPILE_OPTIONS "-Onopropagate") endif() diff --git a/TESTING/LIN/cchkhp.f b/TESTING/LIN/cchkhp.f index 339dec288..f34882f6c 100644 --- a/TESTING/LIN/cchkhp.f +++ b/TESTING/LIN/cchkhp.f @@ -138,7 +138,7 @@ *> *> \param[out] IWORK *> \verbatim -*> IWORK is INTEGER array, dimension (NMAX) +*> IWORK is INTEGER array, dimension (NMAX+2) *> \endverbatim *> *> \param[in] NOUT @@ -183,8 +183,10 @@ SUBROUTINE CCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, * ===================================================================== * * .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) + REAL ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 ) + INTEGER IGUARD + PARAMETER ( IGUARD = -9999 ) INTEGER NTYPES PARAMETER ( NTYPES = 10 ) INTEGER NTESTS @@ -198,6 +200,7 @@ SUBROUTINE CCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ IZERO, J, K, KL, KU, LDA, MODE, N, NERRS, $ NFAIL, NIMAT, NPP, NRHS, NRUN, NT REAL ANORM, CNDNUM, RCOND, RCONDC + REAL RNAN, RONE * .. * .. Local Arrays .. CHARACTER UPLOS( 2 ) @@ -216,7 +219,7 @@ SUBROUTINE CCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ CPPT03, CPPT05 * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -561,6 +564,70 @@ SUBROUTINE CCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 160 CONTINUE 170 CONTINUE * +* A NaN on the diagonal of the last column that CHPTRF visits -- +* column N for UPLO = 'L', column 1 for UPLO = 'U' -- must be +* reported in INFO. That column has no off-diagonal candidate, so +* COLMAX is zero and IMAX is never assigned; unless the pivot itself +* is tested for a NaN every later comparison is false, the code +* reaches the 2-by-2 branch, and it writes IPIV( K+1 ) or +* IPIV( K-1 ) -- one element past an end of IPIV -- with INFO left +* at zero. The NaN column is otherwise zero and the remaining rows +* and columns hold I + ones, which is positive definite, so no +* interchange precedes the NaN and INFO is exactly its index. IPIV +* is passed as IWORK( 2 ) so that a write below its first element +* lands inside IWORK. +* + RONE = ONE + RNAN = SQRT( -RONE ) + DO 200 IN = 1, NN + N = NVAL( IN ) + IF( N.LT.1 ) + $ GO TO 200 + NPP = N*( N+1 ) / 2 + DO 195 IUPLO = 1, 2 + UPLO = UPLOS( IUPLO ) + DO 180 I = 1, NPP + AFAC( I ) = ONE + 180 CONTINUE + IF( IUPLO.EQ.1 ) THEN + IZERO = 1 + DO 185 J = 1, N + IOFF = J*( J-1 ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+1 ) = ZERO + 185 CONTINUE + AFAC( 1 ) = RNAN + ELSE + IZERO = N + DO 190 J = 1, N + IOFF = ( J-1 )*( 2*N-J ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+N ) = ZERO + 190 CONTINUE + AFAC( NPP ) = RNAN + END IF +* + IWORK( 1 ) = IGUARD + IWORK( N+2 ) = IGUARD + SRNAMT = 'CHPTRF' + CALL CHPTRF( UPLO, N, AFAC, IWORK( 2 ), INFO ) +* + IF( INFO.NE.IZERO ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9997 )'CHPTRF', INFO, IZERO, UPLO, N + NFAIL = NFAIL + 1 + END IF + IF( IWORK( 1 ).NE.IGUARD .OR. IWORK( N+2 ).NE.IGUARD ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'CHPTRF', UPLO, N + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 2 + 195 CONTINUE + 200 CONTINUE +* * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) @@ -569,6 +636,10 @@ SUBROUTINE CCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ I2, ', ratio =', G12.5 ) 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', $ I2, ', test(', I2, ') =', G12.5 ) + 9997 FORMAT( ' *** ', A, ' with a NaN pivot returned INFO =', I5, + $ ' instead of', I5, ' for UPLO = ''', A1, ''', N =', I5 ) + 9996 FORMAT( ' *** ', A, ' with a NaN pivot wrote outside IPIV for', + $ ' UPLO = ''', A1, ''', N =', I5 ) RETURN * * End of CCHKHP diff --git a/TESTING/LIN/cchksp.f b/TESTING/LIN/cchksp.f index 7c0a44c78..4b78d8792 100644 --- a/TESTING/LIN/cchksp.f +++ b/TESTING/LIN/cchksp.f @@ -138,7 +138,7 @@ *> *> \param[out] IWORK *> \verbatim -*> IWORK is INTEGER array, dimension (NMAX) +*> IWORK is INTEGER array, dimension (NMAX+2) *> \endverbatim *> *> \param[in] NOUT @@ -183,8 +183,10 @@ SUBROUTINE CCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, * ===================================================================== * * .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) + REAL ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 ) + INTEGER IGUARD + PARAMETER ( IGUARD = -9999 ) INTEGER NTYPES PARAMETER ( NTYPES = 11 ) INTEGER NTESTS @@ -198,6 +200,7 @@ SUBROUTINE CCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ IZERO, J, K, KL, KU, LDA, MODE, N, NERRS, $ NFAIL, NIMAT, NPP, NRHS, NRUN, NT REAL ANORM, CNDNUM, RCOND, RCONDC + REAL RNAN, RONE * .. * .. Local Arrays .. CHARACTER UPLOS( 2 ) @@ -216,7 +219,7 @@ SUBROUTINE CCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ CSPTRI, CSPTRS * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -561,6 +564,70 @@ SUBROUTINE CCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 160 CONTINUE 170 CONTINUE * +* A NaN on the diagonal of the last column that CSPTRF visits -- +* column N for UPLO = 'L', column 1 for UPLO = 'U' -- must be +* reported in INFO. That column has no off-diagonal candidate, so +* COLMAX is zero and IMAX is never assigned; unless the pivot itself +* is tested for a NaN every later comparison is false, the code +* reaches the 2-by-2 branch, and it writes IPIV( K+1 ) or +* IPIV( K-1 ) -- one element past an end of IPIV -- with INFO left +* at zero. The NaN column is otherwise zero and the remaining rows +* and columns hold I + ones, which is positive definite, so no +* interchange precedes the NaN and INFO is exactly its index. IPIV +* is passed as IWORK( 2 ) so that a write below its first element +* lands inside IWORK. +* + RONE = ONE + RNAN = SQRT( -RONE ) + DO 200 IN = 1, NN + N = NVAL( IN ) + IF( N.LT.1 ) + $ GO TO 200 + NPP = N*( N+1 ) / 2 + DO 195 IUPLO = 1, 2 + UPLO = UPLOS( IUPLO ) + DO 180 I = 1, NPP + AFAC( I ) = ONE + 180 CONTINUE + IF( IUPLO.EQ.1 ) THEN + IZERO = 1 + DO 185 J = 1, N + IOFF = J*( J-1 ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+1 ) = ZERO + 185 CONTINUE + AFAC( 1 ) = RNAN + ELSE + IZERO = N + DO 190 J = 1, N + IOFF = ( J-1 )*( 2*N-J ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+N ) = ZERO + 190 CONTINUE + AFAC( NPP ) = RNAN + END IF +* + IWORK( 1 ) = IGUARD + IWORK( N+2 ) = IGUARD + SRNAMT = 'CSPTRF' + CALL CSPTRF( UPLO, N, AFAC, IWORK( 2 ), INFO ) +* + IF( INFO.NE.IZERO ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9997 )'CSPTRF', INFO, IZERO, UPLO, N + NFAIL = NFAIL + 1 + END IF + IF( IWORK( 1 ).NE.IGUARD .OR. IWORK( N+2 ).NE.IGUARD ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'CSPTRF', UPLO, N + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 2 + 195 CONTINUE + 200 CONTINUE +* * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) @@ -569,6 +636,10 @@ SUBROUTINE CCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ I2, ', ratio =', G12.5 ) 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', $ I2, ', test(', I2, ') =', G12.5 ) + 9997 FORMAT( ' *** ', A, ' with a NaN pivot returned INFO =', I5, + $ ' instead of', I5, ' for UPLO = ''', A1, ''', N =', I5 ) + 9996 FORMAT( ' *** ', A, ' with a NaN pivot wrote outside IPIV for', + $ ' UPLO = ''', A1, ''', N =', I5 ) RETURN * * End of CCHKSP diff --git a/TESTING/LIN/dchksp.f b/TESTING/LIN/dchksp.f index b301ec4fa..f9908feb8 100644 --- a/TESTING/LIN/dchksp.f +++ b/TESTING/LIN/dchksp.f @@ -137,7 +137,7 @@ *> *> \param[out] IWORK *> \verbatim -*> IWORK is INTEGER array, dimension (2*NMAX) +*> IWORK is INTEGER array, dimension (2*NMAX+2) *> \endverbatim *> *> \param[in] NOUT @@ -181,8 +181,10 @@ SUBROUTINE DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, * ===================================================================== * * .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) + DOUBLE PRECISION ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 ) + INTEGER IGUARD + PARAMETER ( IGUARD = -9999 ) INTEGER NTYPES PARAMETER ( NTYPES = 10 ) INTEGER NTESTS @@ -196,6 +198,7 @@ SUBROUTINE DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ IZERO, J, K, KL, KU, LDA, MODE, N, NERRS, $ NFAIL, NIMAT, NPP, NRHS, NRUN, NT DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC + DOUBLE PRECISION RNAN, RONE * .. * .. Local Arrays .. CHARACTER UPLOS( 2 ) @@ -214,7 +217,7 @@ SUBROUTINE DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ DSPTRS * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -550,6 +553,70 @@ SUBROUTINE DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 160 CONTINUE 170 CONTINUE * +* A NaN on the diagonal of the last column that DSPTRF visits -- +* column N for UPLO = 'L', column 1 for UPLO = 'U' -- must be +* reported in INFO. That column has no off-diagonal candidate, so +* COLMAX is zero and IMAX is never assigned; unless the pivot itself +* is tested for a NaN every later comparison is false, the code +* reaches the 2-by-2 branch, and it writes IPIV( K+1 ) or +* IPIV( K-1 ) -- one element past an end of IPIV -- with INFO left +* at zero. The NaN column is otherwise zero and the remaining rows +* and columns hold I + ones, which is positive definite, so no +* interchange precedes the NaN and INFO is exactly its index. IPIV +* is passed as IWORK( 2 ) so that a write below its first element +* lands inside IWORK. +* + RONE = ONE + RNAN = SQRT( -RONE ) + DO 200 IN = 1, NN + N = NVAL( IN ) + IF( N.LT.1 ) + $ GO TO 200 + NPP = N*( N+1 ) / 2 + DO 195 IUPLO = 1, 2 + UPLO = UPLOS( IUPLO ) + DO 180 I = 1, NPP + AFAC( I ) = ONE + 180 CONTINUE + IF( IUPLO.EQ.1 ) THEN + IZERO = 1 + DO 185 J = 1, N + IOFF = J*( J-1 ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+1 ) = ZERO + 185 CONTINUE + AFAC( 1 ) = RNAN + ELSE + IZERO = N + DO 190 J = 1, N + IOFF = ( J-1 )*( 2*N-J ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+N ) = ZERO + 190 CONTINUE + AFAC( NPP ) = RNAN + END IF +* + IWORK( 1 ) = IGUARD + IWORK( N+2 ) = IGUARD + SRNAMT = 'DSPTRF' + CALL DSPTRF( UPLO, N, AFAC, IWORK( 2 ), INFO ) +* + IF( INFO.NE.IZERO ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9997 )'DSPTRF', INFO, IZERO, UPLO, N + NFAIL = NFAIL + 1 + END IF + IF( IWORK( 1 ).NE.IGUARD .OR. IWORK( N+2 ).NE.IGUARD ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'DSPTRF', UPLO, N + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 2 + 195 CONTINUE + 200 CONTINUE +* * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) @@ -558,6 +625,10 @@ SUBROUTINE DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ I2, ', ratio =', G12.5 ) 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', $ I2, ', test(', I2, ') =', G12.5 ) + 9997 FORMAT( ' *** ', A, ' with a NaN pivot returned INFO =', I5, + $ ' instead of', I5, ' for UPLO = ''', A1, ''', N =', I5 ) + 9996 FORMAT( ' *** ', A, ' with a NaN pivot wrote outside IPIV for', + $ ' UPLO = ''', A1, ''', N =', I5 ) RETURN * * End of DCHKSP diff --git a/TESTING/LIN/schksp.f b/TESTING/LIN/schksp.f index 3762433b7..69b0aac8f 100644 --- a/TESTING/LIN/schksp.f +++ b/TESTING/LIN/schksp.f @@ -137,7 +137,7 @@ *> *> \param[out] IWORK *> \verbatim -*> IWORK is INTEGER array, dimension (2*NMAX) +*> IWORK is INTEGER array, dimension (2*NMAX+2) *> \endverbatim *> *> \param[in] NOUT @@ -181,8 +181,10 @@ SUBROUTINE SCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, * ===================================================================== * * .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) + REAL ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 ) + INTEGER IGUARD + PARAMETER ( IGUARD = -9999 ) INTEGER NTYPES PARAMETER ( NTYPES = 10 ) INTEGER NTESTS @@ -196,6 +198,7 @@ SUBROUTINE SCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ IZERO, J, K, KL, KU, LDA, MODE, N, NERRS, $ NFAIL, NIMAT, NPP, NRHS, NRUN, NT REAL ANORM, CNDNUM, RCOND, RCONDC + REAL RNAN, RONE * .. * .. Local Arrays .. CHARACTER UPLOS( 2 ) @@ -214,7 +217,7 @@ SUBROUTINE SCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ SSPTRS * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -550,6 +553,70 @@ SUBROUTINE SCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 160 CONTINUE 170 CONTINUE * +* A NaN on the diagonal of the last column that SSPTRF visits -- +* column N for UPLO = 'L', column 1 for UPLO = 'U' -- must be +* reported in INFO. That column has no off-diagonal candidate, so +* COLMAX is zero and IMAX is never assigned; unless the pivot itself +* is tested for a NaN every later comparison is false, the code +* reaches the 2-by-2 branch, and it writes IPIV( K+1 ) or +* IPIV( K-1 ) -- one element past an end of IPIV -- with INFO left +* at zero. The NaN column is otherwise zero and the remaining rows +* and columns hold I + ones, which is positive definite, so no +* interchange precedes the NaN and INFO is exactly its index. IPIV +* is passed as IWORK( 2 ) so that a write below its first element +* lands inside IWORK. +* + RONE = ONE + RNAN = SQRT( -RONE ) + DO 200 IN = 1, NN + N = NVAL( IN ) + IF( N.LT.1 ) + $ GO TO 200 + NPP = N*( N+1 ) / 2 + DO 195 IUPLO = 1, 2 + UPLO = UPLOS( IUPLO ) + DO 180 I = 1, NPP + AFAC( I ) = ONE + 180 CONTINUE + IF( IUPLO.EQ.1 ) THEN + IZERO = 1 + DO 185 J = 1, N + IOFF = J*( J-1 ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+1 ) = ZERO + 185 CONTINUE + AFAC( 1 ) = RNAN + ELSE + IZERO = N + DO 190 J = 1, N + IOFF = ( J-1 )*( 2*N-J ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+N ) = ZERO + 190 CONTINUE + AFAC( NPP ) = RNAN + END IF +* + IWORK( 1 ) = IGUARD + IWORK( N+2 ) = IGUARD + SRNAMT = 'SSPTRF' + CALL SSPTRF( UPLO, N, AFAC, IWORK( 2 ), INFO ) +* + IF( INFO.NE.IZERO ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9997 )'SSPTRF', INFO, IZERO, UPLO, N + NFAIL = NFAIL + 1 + END IF + IF( IWORK( 1 ).NE.IGUARD .OR. IWORK( N+2 ).NE.IGUARD ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'SSPTRF', UPLO, N + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 2 + 195 CONTINUE + 200 CONTINUE +* * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) @@ -558,6 +625,10 @@ SUBROUTINE SCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ I2, ', ratio =', G12.5 ) 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', $ I2, ', test(', I2, ') =', G12.5 ) + 9997 FORMAT( ' *** ', A, ' with a NaN pivot returned INFO =', I5, + $ ' instead of', I5, ' for UPLO = ''', A1, ''', N =', I5 ) + 9996 FORMAT( ' *** ', A, ' with a NaN pivot wrote outside IPIV for', + $ ' UPLO = ''', A1, ''', N =', I5 ) RETURN * * End of SCHKSP diff --git a/TESTING/LIN/zchkhp.f b/TESTING/LIN/zchkhp.f index 93951e141..1b9369897 100644 --- a/TESTING/LIN/zchkhp.f +++ b/TESTING/LIN/zchkhp.f @@ -138,7 +138,7 @@ *> *> \param[out] IWORK *> \verbatim -*> IWORK is INTEGER array, dimension (NMAX) +*> IWORK is INTEGER array, dimension (NMAX+2) *> \endverbatim *> *> \param[in] NOUT @@ -183,8 +183,10 @@ SUBROUTINE ZCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, * ===================================================================== * * .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) + DOUBLE PRECISION ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 ) + INTEGER IGUARD + PARAMETER ( IGUARD = -9999 ) INTEGER NTYPES PARAMETER ( NTYPES = 10 ) INTEGER NTESTS @@ -198,6 +200,7 @@ SUBROUTINE ZCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ IZERO, J, K, KL, KU, LDA, MODE, N, NERRS, $ NFAIL, NIMAT, NPP, NRHS, NRUN, NT DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC + DOUBLE PRECISION RNAN, RONE * .. * .. Local Arrays .. CHARACTER UPLOS( 2 ) @@ -216,7 +219,7 @@ SUBROUTINE ZCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ ZPPT03, ZPPT05 * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -561,6 +564,70 @@ SUBROUTINE ZCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 160 CONTINUE 170 CONTINUE * +* A NaN on the diagonal of the last column that ZHPTRF visits -- +* column N for UPLO = 'L', column 1 for UPLO = 'U' -- must be +* reported in INFO. That column has no off-diagonal candidate, so +* COLMAX is zero and IMAX is never assigned; unless the pivot itself +* is tested for a NaN every later comparison is false, the code +* reaches the 2-by-2 branch, and it writes IPIV( K+1 ) or +* IPIV( K-1 ) -- one element past an end of IPIV -- with INFO left +* at zero. The NaN column is otherwise zero and the remaining rows +* and columns hold I + ones, which is positive definite, so no +* interchange precedes the NaN and INFO is exactly its index. IPIV +* is passed as IWORK( 2 ) so that a write below its first element +* lands inside IWORK. +* + RONE = ONE + RNAN = SQRT( -RONE ) + DO 200 IN = 1, NN + N = NVAL( IN ) + IF( N.LT.1 ) + $ GO TO 200 + NPP = N*( N+1 ) / 2 + DO 195 IUPLO = 1, 2 + UPLO = UPLOS( IUPLO ) + DO 180 I = 1, NPP + AFAC( I ) = ONE + 180 CONTINUE + IF( IUPLO.EQ.1 ) THEN + IZERO = 1 + DO 185 J = 1, N + IOFF = J*( J-1 ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+1 ) = ZERO + 185 CONTINUE + AFAC( 1 ) = RNAN + ELSE + IZERO = N + DO 190 J = 1, N + IOFF = ( J-1 )*( 2*N-J ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+N ) = ZERO + 190 CONTINUE + AFAC( NPP ) = RNAN + END IF +* + IWORK( 1 ) = IGUARD + IWORK( N+2 ) = IGUARD + SRNAMT = 'ZHPTRF' + CALL ZHPTRF( UPLO, N, AFAC, IWORK( 2 ), INFO ) +* + IF( INFO.NE.IZERO ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9997 )'ZHPTRF', INFO, IZERO, UPLO, N + NFAIL = NFAIL + 1 + END IF + IF( IWORK( 1 ).NE.IGUARD .OR. IWORK( N+2 ).NE.IGUARD ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'ZHPTRF', UPLO, N + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 2 + 195 CONTINUE + 200 CONTINUE +* * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) @@ -569,6 +636,10 @@ SUBROUTINE ZCHKHP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ I2, ', ratio =', G12.5 ) 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', $ I2, ', test(', I2, ') =', G12.5 ) + 9997 FORMAT( ' *** ', A, ' with a NaN pivot returned INFO =', I5, + $ ' instead of', I5, ' for UPLO = ''', A1, ''', N =', I5 ) + 9996 FORMAT( ' *** ', A, ' with a NaN pivot wrote outside IPIV for', + $ ' UPLO = ''', A1, ''', N =', I5 ) RETURN * * End of ZCHKHP diff --git a/TESTING/LIN/zchksp.f b/TESTING/LIN/zchksp.f index 43bfc86b8..730823873 100644 --- a/TESTING/LIN/zchksp.f +++ b/TESTING/LIN/zchksp.f @@ -138,7 +138,7 @@ *> *> \param[out] IWORK *> \verbatim -*> IWORK is INTEGER array, dimension (NMAX) +*> IWORK is INTEGER array, dimension (NMAX+2) *> \endverbatim *> *> \param[in] NOUT @@ -183,8 +183,10 @@ SUBROUTINE ZCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, * ===================================================================== * * .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) + DOUBLE PRECISION ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 ) + INTEGER IGUARD + PARAMETER ( IGUARD = -9999 ) INTEGER NTYPES PARAMETER ( NTYPES = 11 ) INTEGER NTESTS @@ -198,6 +200,7 @@ SUBROUTINE ZCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ IZERO, J, K, KL, KU, LDA, MODE, N, NERRS, $ NFAIL, NIMAT, NPP, NRHS, NRUN, NT DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC + DOUBLE PRECISION RNAN, RONE * .. * .. Local Arrays .. CHARACTER UPLOS( 2 ) @@ -216,7 +219,7 @@ SUBROUTINE ZCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ ZSPTRI, ZSPTRS * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -561,6 +564,70 @@ SUBROUTINE ZCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 160 CONTINUE 170 CONTINUE * +* A NaN on the diagonal of the last column that ZSPTRF visits -- +* column N for UPLO = 'L', column 1 for UPLO = 'U' -- must be +* reported in INFO. That column has no off-diagonal candidate, so +* COLMAX is zero and IMAX is never assigned; unless the pivot itself +* is tested for a NaN every later comparison is false, the code +* reaches the 2-by-2 branch, and it writes IPIV( K+1 ) or +* IPIV( K-1 ) -- one element past an end of IPIV -- with INFO left +* at zero. The NaN column is otherwise zero and the remaining rows +* and columns hold I + ones, which is positive definite, so no +* interchange precedes the NaN and INFO is exactly its index. IPIV +* is passed as IWORK( 2 ) so that a write below its first element +* lands inside IWORK. +* + RONE = ONE + RNAN = SQRT( -RONE ) + DO 200 IN = 1, NN + N = NVAL( IN ) + IF( N.LT.1 ) + $ GO TO 200 + NPP = N*( N+1 ) / 2 + DO 195 IUPLO = 1, 2 + UPLO = UPLOS( IUPLO ) + DO 180 I = 1, NPP + AFAC( I ) = ONE + 180 CONTINUE + IF( IUPLO.EQ.1 ) THEN + IZERO = 1 + DO 185 J = 1, N + IOFF = J*( J-1 ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+1 ) = ZERO + 185 CONTINUE + AFAC( 1 ) = RNAN + ELSE + IZERO = N + DO 190 J = 1, N + IOFF = ( J-1 )*( 2*N-J ) / 2 + AFAC( IOFF+J ) = TWO + AFAC( IOFF+N ) = ZERO + 190 CONTINUE + AFAC( NPP ) = RNAN + END IF +* + IWORK( 1 ) = IGUARD + IWORK( N+2 ) = IGUARD + SRNAMT = 'ZSPTRF' + CALL ZSPTRF( UPLO, N, AFAC, IWORK( 2 ), INFO ) +* + IF( INFO.NE.IZERO ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9997 )'ZSPTRF', INFO, IZERO, UPLO, N + NFAIL = NFAIL + 1 + END IF + IF( IWORK( 1 ).NE.IGUARD .OR. IWORK( N+2 ).NE.IGUARD ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9996 )'ZSPTRF', UPLO, N + NFAIL = NFAIL + 1 + END IF + NRUN = NRUN + 2 + 195 CONTINUE + 200 CONTINUE +* * Print a summary of the results. * CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) @@ -569,6 +636,10 @@ SUBROUTINE ZCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, $ I2, ', ratio =', G12.5 ) 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', $ I2, ', test(', I2, ') =', G12.5 ) + 9997 FORMAT( ' *** ', A, ' with a NaN pivot returned INFO =', I5, + $ ' instead of', I5, ' for UPLO = ''', A1, ''', N =', I5 ) + 9996 FORMAT( ' *** ', A, ' with a NaN pivot wrote outside IPIV for', + $ ' UPLO = ''', A1, ''', N =', I5 ) RETURN * * End of ZCHKSP