Merge pull request #3909 from martin-frbg/lapack796
Fix ill-conditioned matrix in LIN testsuite test_rfp (LAPACK PR 796)
This commit is contained in:
Martin Kroeker
GitHub
commit
10be02c896
|
|
@ -156,9 +156,10 @@
|
||||||
REAL RESULT( NTESTS )
|
REAL RESULT( NTESTS )
|
||||||
* ..
|
* ..
|
||||||
* .. External Functions ..
|
* .. External Functions ..
|
||||||
|
LOGICAL LSAME
|
||||||
REAL SLAMCH, CLANGE
|
REAL SLAMCH, CLANGE
|
||||||
COMPLEX CLARND
|
COMPLEX CLARND
|
||||||
EXTERNAL SLAMCH, CLARND, CLANGE
|
EXTERNAL SLAMCH, CLARND, CLANGE, LSAME
|
||||||
* ..
|
* ..
|
||||||
* .. External Subroutines ..
|
* .. External Subroutines ..
|
||||||
EXTERNAL CTRTTF, CGEQRF, CGEQLF, CTFSM, CTRSM
|
EXTERNAL CTRTTF, CGEQRF, CGEQLF, CTFSM, CTRSM
|
||||||
|
|
@ -276,6 +277,20 @@
|
||||||
CALL CGEQRF( NA, NA, A, LDA, TAU,
|
CALL CGEQRF( NA, NA, A, LDA, TAU,
|
||||||
+ C_WORK_CGEQRF, LDA,
|
+ C_WORK_CGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO J = 1, NA
|
||||||
|
DO I = 1, J
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( J, J ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
ELSE
|
ELSE
|
||||||
*
|
*
|
||||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||||
|
|
@ -285,6 +300,20 @@
|
||||||
CALL CGELQF( NA, NA, A, LDA, TAU,
|
CALL CGELQF( NA, NA, A, LDA, TAU,
|
||||||
+ C_WORK_CGEQRF, LDA,
|
+ C_WORK_CGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO I = 1, NA
|
||||||
|
DO J = 1, I
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( I, I ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
END IF
|
END IF
|
||||||
*
|
*
|
||||||
* After the QR factorization, the diagonal
|
* After the QR factorization, the diagonal
|
||||||
|
|
@ -293,7 +322,8 @@
|
||||||
* value 1.0E+00.
|
* value 1.0E+00.
|
||||||
*
|
*
|
||||||
DO J = 1, NA
|
DO J = 1, NA
|
||||||
A( J, J) = A(J,J) * CLARND( 5, ISEED )
|
A( J, J ) = A( J, J ) *
|
||||||
|
+ CLARND( 5, ISEED )
|
||||||
END DO
|
END DO
|
||||||
*
|
*
|
||||||
* Store a copy of A in RFP format (in ARF).
|
* Store a copy of A in RFP format (in ARF).
|
||||||
|
|
|
||||||
|
|
@ -153,8 +153,9 @@
|
||||||
DOUBLE PRECISION RESULT( NTESTS )
|
DOUBLE PRECISION RESULT( NTESTS )
|
||||||
* ..
|
* ..
|
||||||
* .. External Functions ..
|
* .. External Functions ..
|
||||||
|
LOGICAL LSAME
|
||||||
DOUBLE PRECISION DLAMCH, DLANGE, DLARND
|
DOUBLE PRECISION DLAMCH, DLANGE, DLARND
|
||||||
EXTERNAL DLAMCH, DLANGE, DLARND
|
EXTERNAL DLAMCH, DLANGE, DLARND, LSAME
|
||||||
* ..
|
* ..
|
||||||
* .. External Subroutines ..
|
* .. External Subroutines ..
|
||||||
EXTERNAL DTRTTF, DGEQRF, DGEQLF, DTFSM, DTRSM
|
EXTERNAL DTRTTF, DGEQRF, DGEQLF, DTFSM, DTRSM
|
||||||
|
|
@ -272,6 +273,20 @@
|
||||||
CALL DGEQRF( NA, NA, A, LDA, TAU,
|
CALL DGEQRF( NA, NA, A, LDA, TAU,
|
||||||
+ D_WORK_DGEQRF, LDA,
|
+ D_WORK_DGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO J = 1, NA
|
||||||
|
DO I = 1, J
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( J, J ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
ELSE
|
ELSE
|
||||||
*
|
*
|
||||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||||
|
|
@ -281,6 +296,20 @@
|
||||||
CALL DGELQF( NA, NA, A, LDA, TAU,
|
CALL DGELQF( NA, NA, A, LDA, TAU,
|
||||||
+ D_WORK_DGEQRF, LDA,
|
+ D_WORK_DGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO I = 1, NA
|
||||||
|
DO J = 1, I
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( I, I ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
END IF
|
END IF
|
||||||
*
|
*
|
||||||
* Store a copy of A in RFP format (in ARF).
|
* Store a copy of A in RFP format (in ARF).
|
||||||
|
|
|
||||||
|
|
@ -153,8 +153,9 @@
|
||||||
REAL RESULT( NTESTS )
|
REAL RESULT( NTESTS )
|
||||||
* ..
|
* ..
|
||||||
* .. External Functions ..
|
* .. External Functions ..
|
||||||
|
LOGICAL LSAME
|
||||||
REAL SLAMCH, SLANGE, SLARND
|
REAL SLAMCH, SLANGE, SLARND
|
||||||
EXTERNAL SLAMCH, SLANGE, SLARND
|
EXTERNAL SLAMCH, SLANGE, SLARND, LSAME
|
||||||
* ..
|
* ..
|
||||||
* .. External Subroutines ..
|
* .. External Subroutines ..
|
||||||
EXTERNAL STRTTF, SGEQRF, SGEQLF, STFSM, STRSM
|
EXTERNAL STRTTF, SGEQRF, SGEQLF, STFSM, STRSM
|
||||||
|
|
@ -272,6 +273,20 @@
|
||||||
CALL SGEQRF( NA, NA, A, LDA, TAU,
|
CALL SGEQRF( NA, NA, A, LDA, TAU,
|
||||||
+ S_WORK_SGEQRF, LDA,
|
+ S_WORK_SGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO J = 1, NA
|
||||||
|
DO I = 1, J
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( J, J ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
ELSE
|
ELSE
|
||||||
*
|
*
|
||||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||||
|
|
@ -281,6 +296,20 @@
|
||||||
CALL SGELQF( NA, NA, A, LDA, TAU,
|
CALL SGELQF( NA, NA, A, LDA, TAU,
|
||||||
+ S_WORK_SGEQRF, LDA,
|
+ S_WORK_SGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO I = 1, NA
|
||||||
|
DO J = 1, I
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( I, I ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
END IF
|
END IF
|
||||||
*
|
*
|
||||||
* Store a copy of A in RFP format (in ARF).
|
* Store a copy of A in RFP format (in ARF).
|
||||||
|
|
|
||||||
|
|
@ -156,9 +156,10 @@
|
||||||
DOUBLE PRECISION RESULT( NTESTS )
|
DOUBLE PRECISION RESULT( NTESTS )
|
||||||
* ..
|
* ..
|
||||||
* .. External Functions ..
|
* .. External Functions ..
|
||||||
|
LOGICAL LSAME
|
||||||
DOUBLE PRECISION DLAMCH, ZLANGE
|
DOUBLE PRECISION DLAMCH, ZLANGE
|
||||||
COMPLEX*16 ZLARND
|
COMPLEX*16 ZLARND
|
||||||
EXTERNAL DLAMCH, ZLARND, ZLANGE
|
EXTERNAL DLAMCH, ZLARND, ZLANGE, LSAME
|
||||||
* ..
|
* ..
|
||||||
* .. External Subroutines ..
|
* .. External Subroutines ..
|
||||||
EXTERNAL ZTRTTF, ZGEQRF, ZGEQLF, ZTFSM, ZTRSM
|
EXTERNAL ZTRTTF, ZGEQRF, ZGEQLF, ZTFSM, ZTRSM
|
||||||
|
|
@ -276,6 +277,20 @@
|
||||||
CALL ZGEQRF( NA, NA, A, LDA, TAU,
|
CALL ZGEQRF( NA, NA, A, LDA, TAU,
|
||||||
+ Z_WORK_ZGEQRF, LDA,
|
+ Z_WORK_ZGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO J = 1, NA
|
||||||
|
DO I = 1, J
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( J, J ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
ELSE
|
ELSE
|
||||||
*
|
*
|
||||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||||
|
|
@ -285,6 +300,20 @@
|
||||||
CALL ZGELQF( NA, NA, A, LDA, TAU,
|
CALL ZGELQF( NA, NA, A, LDA, TAU,
|
||||||
+ Z_WORK_ZGEQRF, LDA,
|
+ Z_WORK_ZGEQRF, LDA,
|
||||||
+ INFO )
|
+ INFO )
|
||||||
|
*
|
||||||
|
* Forcing main diagonal of test matrix to
|
||||||
|
* be unit makes it ill-conditioned for
|
||||||
|
* some test cases
|
||||||
|
*
|
||||||
|
IF ( LSAME( DIAG, 'U' ) ) THEN
|
||||||
|
DO I = 1, NA
|
||||||
|
DO J = 1, I
|
||||||
|
A( I, J ) = A( I, J ) /
|
||||||
|
+ ( 2.0 * A( I, I ) )
|
||||||
|
END DO
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
*
|
||||||
END IF
|
END IF
|
||||||
*
|
*
|
||||||
* After the QR factorization, the diagonal
|
* After the QR factorization, the diagonal
|
||||||
|
|
@ -293,7 +322,8 @@
|
||||||
* value 1.0E+00.
|
* value 1.0E+00.
|
||||||
*
|
*
|
||||||
DO J = 1, NA
|
DO J = 1, NA
|
||||||
A( J, J) = A(J,J) * ZLARND( 5, ISEED )
|
A( J, J ) = A( J, J ) *
|
||||||
|
+ ZLARND( 5, ISEED )
|
||||||
END DO
|
END DO
|
||||||
*
|
*
|
||||||
* Store a copy of A in RFP format (in ARF).
|
* Store a copy of A in RFP format (in ARF).
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue