floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Replace deprecated ?GELQS and ?GEQRS (Reference-LAPACK PR 900)

This commit is contained in:
Martin Kroeker 2023-11-11 19:29:21 +01:00 committed by GitHub
parent c1ba3dd1fe
commit ab3d6a6604
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
16 changed files with 114 additions and 266 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lapack-netlib/TESTING/LIN/cchklq.f
View File

@ -235,7 +235,7 @@
REAL RESULT( NTESTS ) REAL RESULT( NTESTS )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, CERRLQ, CGELQS, CGET02, EXTERNAL ALAERH, ALAHD, ALASUM, CERRLQ, CGELS, CGET02,
$ CLACPY, CLARHS, CLATB4, CLATMS, CLQT01, CLQT02, $ CLACPY, CLARHS, CLATB4, CLATMS, CLQT01, CLQT02,
$ CLQT03, XLAENV $ CLQT03, XLAENV
* .. * ..
@ -370,7 +370,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call CGELQS to solve a system * If M<=N and K=M, call CGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -387,14 +387,20 @@
* *
CALL CLACPY( 'Full', M, NRHS, B, LDA, X, CALL CLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'CGELQS'
CALL CGELQS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from CGELQS. * Reset AF to the original matrix. CGELS
* factors the matrix before solving the system.
*
CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'CGELS'
CALL CGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from CGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'CGELQS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'CGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

22
lapack-netlib/TESTING/LIN/cchkqr.f
View File

@ -244,7 +244,7 @@
EXTERNAL CGENND EXTERNAL CGENND
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, CERRQR, CGEQRS, CGET02, EXTERNAL ALAERH, ALAHD, ALASUM, CERRQR, CGELS, CGET02,
$ CLACPY, CLARHS, CLATB4, CLATMS, CQRT01, $ CLACPY, CLARHS, CLATB4, CLATMS, CQRT01,
$ CQRT01P, CQRT02, CQRT03, XLAENV $ CQRT01P, CQRT02, CQRT03, XLAENV
* .. * ..
@ -371,7 +371,7 @@
IF( .NOT. CGENND( M, N, AF, LDA ) ) IF( .NOT. CGENND( M, N, AF, LDA ) )
$ RESULT( 9 ) = 2*THRESH $ RESULT( 9 ) = 2*THRESH
NT = NT + 1 NT = NT + 1
ELSE IF( M.GE.N ) THEN ELSE IF( M.GE.N ) THEN
* *
* Test CUNGQR, using factorization * Test CUNGQR, using factorization
* returned by CQRT01 * returned by CQRT01
@ -388,7 +388,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call CGEQRS to solve a system * If M>=N and K=N, call CGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -405,14 +405,20 @@
* *
CALL CLACPY( 'Full', M, NRHS, B, LDA, X, CALL CLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'CGEQRS'
CALL CGEQRS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from CGEQRS. * Reset AF to the original matrix. CGELS
* factors the matrix before solving the system.
*
CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'CGELS'
CALL CGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from CGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'CGEQRS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'CGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

27
lapack-netlib/TESTING/LIN/cerrlq.f
View File

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX ) $ W( NMAX ), X( NMAX )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CGELQ2, CGELQF, CGELQS, CHKXER, CUNGL2, EXTERNAL ALAESM, CGELQ2, CGELQF, CHKXER, CUNGL2,
$ CUNGLQ, CUNML2, CUNMLQ $ CUNGLQ, CUNML2, CUNMLQ
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -140,31 +140,6 @@
CALL CGELQ2( 2, 1, A, 1, B, W, INFO ) CALL CGELQ2( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'CGELQ2', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CGELQ2', INFOT, NOUT, LERR, OK )
* *
* CGELQS
*
SRNAMT = 'CGELQS'
INFOT = 1
CALL CGELQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL CGELQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL CGELQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGELQS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL CGELQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGELQS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL CGELQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'CGELQS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL CGELQS( 1, 2, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGELQS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL CGELQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGELQS', INFOT, NOUT, LERR, OK )
*
* CUNGLQ * CUNGLQ
* *
SRNAMT = 'CUNGLQ' SRNAMT = 'CUNGLQ'

27
lapack-netlib/TESTING/LIN/cerrqr.f
View File

@ -77,7 +77,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CGEQR2, CGEQR2P, CGEQRF, CGEQRFP, EXTERNAL ALAESM, CGEQR2, CGEQR2P, CGEQRF, CGEQRFP,
$ CGEQRS, CHKXER, CUNG2R, CUNGQR, CUNM2R, $ CHKXER, CUNG2R, CUNGQR, CUNM2R,
$ CUNMQR $ CUNMQR
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -170,31 +170,6 @@
CALL CGEQR2P( 2, 1, A, 1, B, W, INFO ) CALL CGEQR2P( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK )
* *
* CGEQRS
*
SRNAMT = 'CGEQRS'
INFOT = 1
CALL CGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL CGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL CGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO )
CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL CGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL CGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL CGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL CGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK )
*
* CUNGQR * CUNGQR
* *
SRNAMT = 'CUNGQR' SRNAMT = 'CUNGQR'

20
lapack-netlib/TESTING/LIN/dchklq.f
View File

@ -235,7 +235,7 @@
DOUBLE PRECISION RESULT( NTESTS ) DOUBLE PRECISION RESULT( NTESTS )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELQS, DGET02, EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELS, DGET02,
$ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02, $ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02,
$ DLQT03, XLAENV $ DLQT03, XLAENV
* .. * ..
@ -373,7 +373,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call DGELQS to solve a system * If M<=N and K=M, call DGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -390,14 +390,20 @@
* *
CALL DLACPY( 'Full', M, NRHS, B, LDA, X, CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'DGELQS'
CALL DGELQS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from DGELQS. * Reset AF to the original matrix. DGELS
* factors the matrix before solving the system.
*
CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'DGELS'
CALL DGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from DGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'DGELQS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'DGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

22
lapack-netlib/TESTING/LIN/dchkqr.f
View File

@ -244,7 +244,7 @@
EXTERNAL DGENND EXTERNAL DGENND
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGEQRS, DGET02, EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGELS, DGET02,
$ DLACPY, DLARHS, DLATB4, DLATMS, DQRT01, $ DLACPY, DLARHS, DLATB4, DLATMS, DQRT01,
$ DQRT01P, DQRT02, DQRT03, XLAENV $ DQRT01P, DQRT02, DQRT03, XLAENV
* .. * ..
@ -372,7 +372,7 @@
IF( .NOT. DGENND( M, N, AF, LDA ) ) IF( .NOT. DGENND( M, N, AF, LDA ) )
$ RESULT( 9 ) = 2*THRESH $ RESULT( 9 ) = 2*THRESH
NT = NT + 1 NT = NT + 1
ELSE IF( M.GE.N ) THEN ELSE IF( M.GE.N ) THEN
* *
* Test DORGQR, using factorization * Test DORGQR, using factorization
* returned by DQRT01 * returned by DQRT01
@ -389,7 +389,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call DGEQRS to solve a system * If M>=N and K=N, call DGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -406,14 +406,20 @@
* *
CALL DLACPY( 'Full', M, NRHS, B, LDA, X, CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'DGEQRS'
CALL DGEQRS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from DGEQRS. * Reset AF. DGELS overwrites the matrix with
* its factorization.
*
CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'DGELS'
CALL DGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from DGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'DGEQRS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'DGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

27
lapack-netlib/TESTING/LIN/derrlq.f
View File

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX ) $ W( NMAX ), X( NMAX )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, DGELQ2, DGELQF, DGELQS, DORGL2, EXTERNAL ALAESM, CHKXER, DGELQ2, DGELQF, DORGL2,
$ DORGLQ, DORML2, DORMLQ $ DORGLQ, DORML2, DORMLQ
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -140,31 +140,6 @@
CALL DGELQ2( 2, 1, A, 1, B, W, INFO ) CALL DGELQ2( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'DGELQ2', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DGELQ2', INFOT, NOUT, LERR, OK )
* *
* DGELQS
*
SRNAMT = 'DGELQS'
INFOT = 1
CALL DGELQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL DGELQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL DGELQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGELQS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL DGELQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGELQS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL DGELQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'DGELQS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL DGELQS( 1, 2, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGELQS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL DGELQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGELQS', INFOT, NOUT, LERR, OK )
*
* DORGLQ * DORGLQ
* *
SRNAMT = 'DORGLQ' SRNAMT = 'DORGLQ'

27
lapack-netlib/TESTING/LIN/derrqr.f
View File

@ -77,7 +77,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, DGEQR2, DGEQR2P, DGEQRF, EXTERNAL ALAESM, CHKXER, DGEQR2, DGEQR2P, DGEQRF,
$ DGEQRFP, DGEQRS, DORG2R, DORGQR, DORM2R, $ DGEQRFP, DORG2R, DORGQR, DORM2R,
$ DORMQR $ DORMQR
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -170,31 +170,6 @@
CALL DGEQR2P( 2, 1, A, 1, B, W, INFO ) CALL DGEQR2P( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'DGEQR2P', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'DGEQR2P', INFOT, NOUT, LERR, OK )
* *
* DGEQRS
*
SRNAMT = 'DGEQRS'
INFOT = 1
CALL DGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL DGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL DGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO )
CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL DGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL DGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL DGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL DGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'DGEQRS', INFOT, NOUT, LERR, OK )
*
* DORGQR * DORGQR
* *
SRNAMT = 'DORGQR' SRNAMT = 'DORGQR'

20
lapack-netlib/TESTING/LIN/schklq.f
View File

@ -235,7 +235,7 @@
REAL RESULT( NTESTS ) REAL RESULT( NTESTS )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGELQS, SGET02, EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGET02,
$ SLACPY, SLARHS, SLATB4, SLATMS, SLQT01, SLQT02, $ SLACPY, SLARHS, SLATB4, SLATMS, SLQT01, SLQT02,
$ SLQT03, XLAENV $ SLQT03, XLAENV
* .. * ..
@ -370,7 +370,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call SGELQS to solve a system * If M<=N and K=M, call SGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -387,14 +387,20 @@
* *
CALL SLACPY( 'Full', M, NRHS, B, LDA, X, CALL SLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'SGELQS'
CALL SGELQS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from SGELQS. * Reset AF to the original matrix. SGELS
* factors the matrix before solving the system.
*
CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'SGELS'
CALL SGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from SGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'SGELQS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'SGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

20
lapack-netlib/TESTING/LIN/schkqr.f
View File

@ -244,7 +244,7 @@
EXTERNAL SGENND EXTERNAL SGENND
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGEQRS, SGET02, EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGELS, SGET02,
$ SLACPY, SLARHS, SLATB4, SLATMS, SQRT01, $ SLACPY, SLARHS, SLATB4, SLATMS, SQRT01,
$ SQRT01P, SQRT02, SQRT03, XLAENV $ SQRT01P, SQRT02, SQRT03, XLAENV
* .. * ..
@ -388,7 +388,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call SGEQRS to solve a system * If M>=N and K=N, call SGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -405,14 +405,20 @@
* *
CALL SLACPY( 'Full', M, NRHS, B, LDA, X, CALL SLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'SGEQRS'
CALL SGEQRS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from SGEQRS. * Reset AF to the original matrix. SGELS
* factors the matrix before solving the system.
*
CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'SGELS'
CALL SGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from SGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'SGEQRS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'SGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

27
lapack-netlib/TESTING/LIN/serrlq.f
View File

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX ) $ W( NMAX ), X( NMAX )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, SGELQ2, SGELQF, SGELQS, SORGL2, EXTERNAL ALAESM, CHKXER, SGELQ2, SGELQF, SORGL2,
$ SORGLQ, SORML2, SORMLQ $ SORGLQ, SORML2, SORMLQ
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -140,31 +140,6 @@
CALL SGELQ2( 2, 1, A, 1, B, W, INFO ) CALL SGELQ2( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'SGELQ2', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SGELQ2', INFOT, NOUT, LERR, OK )
* *
* SGELQS
*
SRNAMT = 'SGELQS'
INFOT = 1
CALL SGELQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL SGELQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL SGELQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGELQS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL SGELQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGELQS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL SGELQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'SGELQS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL SGELQS( 1, 2, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGELQS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL SGELQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGELQS', INFOT, NOUT, LERR, OK )
*
* SORGLQ * SORGLQ
* *
SRNAMT = 'SORGLQ' SRNAMT = 'SORGLQ'

27
lapack-netlib/TESTING/LIN/serrqr.f
View File

@ -77,7 +77,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, SGEQR2, SGEQR2P, SGEQRF, EXTERNAL ALAESM, CHKXER, SGEQR2, SGEQR2P, SGEQRF,
$ SGEQRFP, SGEQRS, SORG2R, SORGQR, SORM2R, $ SGEQRFP, SORG2R, SORGQR, SORM2R,
$ SORMQR $ SORMQR
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -170,31 +170,6 @@
CALL SGEQR2P( 2, 1, A, 1, B, W, INFO ) CALL SGEQR2P( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'SGEQR2P', INFOT, NOUT, LERR, OK )
* *
* SGEQRS
*
SRNAMT = 'SGEQRS'
INFOT = 1
CALL SGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL SGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL SGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO )
CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL SGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL SGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL SGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL SGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'SGEQRS', INFOT, NOUT, LERR, OK )
*
* SORGQR * SORGQR
* *
SRNAMT = 'SORGQR' SRNAMT = 'SORGQR'

20
lapack-netlib/TESTING/LIN/zchklq.f
View File

@ -235,7 +235,7 @@
DOUBLE PRECISION RESULT( NTESTS ) DOUBLE PRECISION RESULT( NTESTS )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRLQ, ZGELQS, EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRLQ, ZGELS,
$ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLQT01, $ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLQT01,
$ ZLQT02, ZLQT03 $ ZLQT02, ZLQT03
* .. * ..
@ -370,7 +370,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call ZGELQS to solve a system * If M<=N and K=M, call ZGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -387,14 +387,20 @@
* *
CALL ZLACPY( 'Full', M, NRHS, B, LDA, X, CALL ZLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'ZGELQS'
CALL ZGELQS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from ZGELQS. * Reset AF to the original matrix. ZGELS
* factors the matrix before solving the system.
*
CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'ZGELS'
CALL ZGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from ZGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'ZGELQS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'ZGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

20
lapack-netlib/TESTING/LIN/zchkqr.f
View File

@ -244,7 +244,7 @@
EXTERNAL ZGENND EXTERNAL ZGENND
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRQR, ZGEQRS, EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRQR, ZGELS,
$ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZQRT01, $ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZQRT01,
$ ZQRT01P, ZQRT02, ZQRT03 $ ZQRT01P, ZQRT02, ZQRT03
* .. * ..
@ -388,7 +388,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) ) $ WORK, LWORK, RWORK, RESULT( 3 ) )
NT = NT + 4 NT = NT + 4
* *
* If M>=N and K=N, call ZGEQRS to solve a system * If M>=N and K=N, call ZGELS to solve a system
* with NRHS right hand sides and compute the * with NRHS right hand sides and compute the
* residual. * residual.
* *
@ -405,14 +405,20 @@
* *
CALL ZLACPY( 'Full', M, NRHS, B, LDA, X, CALL ZLACPY( 'Full', M, NRHS, B, LDA, X,
$ LDA ) $ LDA )
SRNAMT = 'ZGEQRS'
CALL ZGEQRS( M, N, NRHS, AF, LDA, TAU, X,
$ LDA, WORK, LWORK, INFO )
* *
* Check error code from ZGEQRS. * Reset AF to the original matrix. ZGELS
* factors the matrix before solving the system.
*
CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA )
*
SRNAMT = 'ZGELS'
CALL ZGELS( 'No transpose', M, N, NRHS, AF,
$ LDA, X, LDA, WORK, LWORK, INFO )
*
* Check error code from ZGELS.
* *
IF( INFO.NE.0 ) IF( INFO.NE.0 )
$ CALL ALAERH( PATH, 'ZGEQRS', INFO, 0, ' ', $ CALL ALAERH( PATH, 'ZGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT, $ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT ) $ NFAIL, NERRS, NOUT )
* *

27
lapack-netlib/TESTING/LIN/zerrlq.f
View File

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX ) $ W( NMAX ), X( NMAX )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, ZGELQ2, ZGELQF, ZGELQS, ZUNGL2, EXTERNAL ALAESM, CHKXER, ZGELQ2, ZGELQF, ZUNGL2,
$ ZUNGLQ, ZUNML2, ZUNMLQ $ ZUNGLQ, ZUNML2, ZUNMLQ
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -142,31 +142,6 @@
CALL ZGELQ2( 2, 1, A, 1, B, W, INFO ) CALL ZGELQ2( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'ZGELQ2', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZGELQ2', INFOT, NOUT, LERR, OK )
* *
* ZGELQS
*
SRNAMT = 'ZGELQS'
INFOT = 1
CALL ZGELQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL ZGELQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGELQS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL ZGELQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGELQS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL ZGELQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGELQS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL ZGELQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'ZGELQS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL ZGELQS( 1, 2, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGELQS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL ZGELQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGELQS', INFOT, NOUT, LERR, OK )
*
* ZUNGLQ * ZUNGLQ
* *
SRNAMT = 'ZUNGLQ' SRNAMT = 'ZUNGLQ'

27
lapack-netlib/TESTING/LIN/zerrqr.f
View File

@ -77,7 +77,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, ZGEQR2, ZGEQR2P, ZGEQRF, EXTERNAL ALAESM, CHKXER, ZGEQR2, ZGEQR2P, ZGEQRF,
$ ZGEQRFP, ZGEQRS, ZUNG2R, ZUNGQR, ZUNM2R, $ ZGEQRFP, ZUNG2R, ZUNGQR, ZUNM2R,
$ ZUNMQR $ ZUNMQR
* .. * ..
* .. Scalars in Common .. * .. Scalars in Common ..
@ -172,31 +172,6 @@
CALL ZGEQR2P( 2, 1, A, 1, B, W, INFO ) CALL ZGEQR2P( 2, 1, A, 1, B, W, INFO )
CALL CHKXER( 'ZGEQR2P', INFOT, NOUT, LERR, OK ) CALL CHKXER( 'ZGEQR2P', INFOT, NOUT, LERR, OK )
* *
* ZGEQRS
*
SRNAMT = 'ZGEQRS'
INFOT = 1
CALL ZGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL ZGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL ZGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO )
CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL ZGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL ZGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 8
CALL ZGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK )
INFOT = 10
CALL ZGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK )
*
* ZUNGQR * ZUNGQR
* *
SRNAMT = 'ZUNGQR' SRNAMT = 'ZUNGQR'