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 )
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
REAL SLAMCH, CLANGE
|
||||
COMPLEX CLARND
|
||||
EXTERNAL SLAMCH, CLARND, CLANGE
|
||||
EXTERNAL SLAMCH, CLARND, CLANGE, LSAME
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CTRTTF, CGEQRF, CGEQLF, CTFSM, CTRSM
|
||||
|
|
@ -276,6 +277,20 @@
|
|||
CALL CGEQRF( NA, NA, A, LDA, TAU,
|
||||
+ C_WORK_CGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||
|
|
@ -285,6 +300,20 @@
|
|||
CALL CGELQF( NA, NA, A, LDA, TAU,
|
||||
+ C_WORK_CGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* After the QR factorization, the diagonal
|
||||
|
|
@ -293,7 +322,8 @@
|
|||
* value 1.0E+00.
|
||||
*
|
||||
DO J = 1, NA
|
||||
A( J, J) = A(J,J) * CLARND( 5, ISEED )
|
||||
A( J, J ) = A( J, J ) *
|
||||
+ CLARND( 5, ISEED )
|
||||
END DO
|
||||
*
|
||||
* Store a copy of A in RFP format (in ARF).
|
||||
|
|
|
|||
|
|
@ -153,8 +153,9 @@
|
|||
DOUBLE PRECISION RESULT( NTESTS )
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
DOUBLE PRECISION DLAMCH, DLANGE, DLARND
|
||||
EXTERNAL DLAMCH, DLANGE, DLARND
|
||||
EXTERNAL DLAMCH, DLANGE, DLARND, LSAME
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DTRTTF, DGEQRF, DGEQLF, DTFSM, DTRSM
|
||||
|
|
@ -272,6 +273,20 @@
|
|||
CALL DGEQRF( NA, NA, A, LDA, TAU,
|
||||
+ D_WORK_DGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||
|
|
@ -281,6 +296,20 @@
|
|||
CALL DGELQF( NA, NA, A, LDA, TAU,
|
||||
+ D_WORK_DGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* Store a copy of A in RFP format (in ARF).
|
||||
|
|
|
|||
|
|
@ -153,8 +153,9 @@
|
|||
REAL RESULT( NTESTS )
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
REAL SLAMCH, SLANGE, SLARND
|
||||
EXTERNAL SLAMCH, SLANGE, SLARND
|
||||
EXTERNAL SLAMCH, SLANGE, SLARND, LSAME
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL STRTTF, SGEQRF, SGEQLF, STFSM, STRSM
|
||||
|
|
@ -272,6 +273,20 @@
|
|||
CALL SGEQRF( NA, NA, A, LDA, TAU,
|
||||
+ S_WORK_SGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||
|
|
@ -281,6 +296,20 @@
|
|||
CALL SGELQF( NA, NA, A, LDA, TAU,
|
||||
+ S_WORK_SGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* Store a copy of A in RFP format (in ARF).
|
||||
|
|
|
|||
|
|
@ -156,9 +156,10 @@
|
|||
DOUBLE PRECISION RESULT( NTESTS )
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
DOUBLE PRECISION DLAMCH, ZLANGE
|
||||
COMPLEX*16 ZLARND
|
||||
EXTERNAL DLAMCH, ZLARND, ZLANGE
|
||||
EXTERNAL DLAMCH, ZLARND, ZLANGE, LSAME
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ZTRTTF, ZGEQRF, ZGEQLF, ZTFSM, ZTRSM
|
||||
|
|
@ -276,6 +277,20 @@
|
|||
CALL ZGEQRF( NA, NA, A, LDA, TAU,
|
||||
+ Z_WORK_ZGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* The case IUPLO.EQ.2 is when SIDE.EQ.'L'
|
||||
|
|
@ -285,6 +300,20 @@
|
|||
CALL ZGELQF( NA, NA, A, LDA, TAU,
|
||||
+ Z_WORK_ZGEQRF, LDA,
|
||||
+ 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
|
||||
*
|
||||
* After the QR factorization, the diagonal
|
||||
|
|
@ -293,7 +322,8 @@
|
|||
* value 1.0E+00.
|
||||
*
|
||||
DO J = 1, NA
|
||||
A( J, J) = A(J,J) * ZLARND( 5, ISEED )
|
||||
A( J, J ) = A( J, J ) *
|
||||
+ ZLARND( 5, ISEED )
|
||||
END DO
|
||||
*
|
||||
* Store a copy of A in RFP format (in ARF).
|
||||
|
|
|
|||
Loading…
Reference in New Issue