Skip to content

Test that a NaN pivot is reported by the packed symmetric-indefinite factorizations #1393

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
rmlarsen wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Test that a NaN pivot is reported by the packed symmetric-indefinite factorizations #1393

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 6 additions & 3 deletions TESTING/LIN/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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()

Expand Down Expand Up @@ -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()
Expand Down
79 changes: 75 additions & 4 deletions TESTING/LIN/cchkhp.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 )
Expand All @@ -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
Expand Down Expand Up @@ -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 )
Expand All @@ -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
Expand Down
79 changes: 75 additions & 4 deletions TESTING/LIN/cchksp.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 )
Expand All @@ -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
Expand Down Expand Up @@ -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 )
Expand All @@ -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
Expand Down
79 changes: 75 additions & 4 deletions TESTING/LIN/dchksp.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 )
Expand All @@ -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
Expand Down Expand Up @@ -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 )
Expand All @@ -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
Expand Down
Loading
Loading