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 )
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, CERRLQ, CGELQS, CGET02,
EXTERNAL ALAERH, ALAHD, ALASUM, CERRLQ, CGELS, CGET02,
$ CLACPY, CLARHS, CLATB4, CLATMS, CLQT01, CLQT02,
$ CLQT03, XLAENV
* ..
@ -370,7 +370,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -387,14 +387,20 @@
*
CALL CLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'CGELQS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'CGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -244,7 +244,7 @@
EXTERNAL CGENND
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, CERRQR, CGEQRS, CGET02,
EXTERNAL ALAERH, ALAHD, ALASUM, CERRQR, CGELS, CGET02,
$ CLACPY, CLARHS, CLATB4, CLATMS, CQRT01,
$ CQRT01P, CQRT02, CQRT03, XLAENV
* ..
@ -371,7 +371,7 @@
IF( .NOT. CGENND( M, N, AF, LDA ) )
$ RESULT( 9 ) = 2*THRESH
NT = NT + 1
ELSE IF( M.GE.N ) THEN
ELSE IF( M.GE.N ) THEN
*
* Test CUNGQR, using factorization
* returned by CQRT01
@ -388,7 +388,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -405,14 +405,20 @@
*
CALL CLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'CGEQRS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'CGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX )
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CGELQ2, CGELQF, CGELQS, CHKXER, CUNGL2,
EXTERNAL ALAESM, CGELQ2, CGELQF, CHKXER, CUNGL2,
$ CUNGLQ, CUNML2, CUNMLQ
* ..
* .. Scalars in Common ..
@ -140,31 +140,6 @@
CALL CGELQ2( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'CUNGLQ'

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

@ -77,7 +77,7 @@
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CGEQR2, CGEQR2P, CGEQRF, CGEQRFP,
$ CGEQRS, CHKXER, CUNG2R, CUNGQR, CUNM2R,
$ CHKXER, CUNG2R, CUNGQR, CUNM2R,
$ CUNMQR
* ..
* .. Scalars in Common ..
@ -170,31 +170,6 @@
CALL CGEQR2P( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'CUNGQR'

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

@ -235,7 +235,7 @@
DOUBLE PRECISION RESULT( NTESTS )
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELQS, DGET02,
EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELS, DGET02,
$ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02,
$ DLQT03, XLAENV
* ..
@ -373,7 +373,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -390,14 +390,20 @@
*
CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'DGELQS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'DGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -244,7 +244,7 @@
EXTERNAL DGENND
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGEQRS, DGET02,
EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGELS, DGET02,
$ DLACPY, DLARHS, DLATB4, DLATMS, DQRT01,
$ DQRT01P, DQRT02, DQRT03, XLAENV
* ..
@ -372,7 +372,7 @@
IF( .NOT. DGENND( M, N, AF, LDA ) )
$ RESULT( 9 ) = 2*THRESH
NT = NT + 1
ELSE IF( M.GE.N ) THEN
ELSE IF( M.GE.N ) THEN
*
* Test DORGQR, using factorization
* returned by DQRT01
@ -389,7 +389,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -406,14 +406,20 @@
*
CALL DLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'DGEQRS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'DGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX )
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, DGELQ2, DGELQF, DGELQS, DORGL2,
EXTERNAL ALAESM, CHKXER, DGELQ2, DGELQF, DORGL2,
$ DORGLQ, DORML2, DORMLQ
* ..
* .. Scalars in Common ..
@ -140,31 +140,6 @@
CALL DGELQ2( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'DORGLQ'

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

@ -77,7 +77,7 @@
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, DGEQR2, DGEQR2P, DGEQRF,
$ DGEQRFP, DGEQRS, DORG2R, DORGQR, DORM2R,
$ DGEQRFP, DORG2R, DORGQR, DORM2R,
$ DORMQR
* ..
* .. Scalars in Common ..
@ -170,31 +170,6 @@
CALL DGEQR2P( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'DORGQR'

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

@ -235,7 +235,7 @@
REAL RESULT( NTESTS )
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGELQS, SGET02,
EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGET02,
$ SLACPY, SLARHS, SLATB4, SLATMS, SLQT01, SLQT02,
$ SLQT03, XLAENV
* ..
@ -370,7 +370,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -387,14 +387,20 @@
*
CALL SLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'SGELQS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'SGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -244,7 +244,7 @@
EXTERNAL SGENND
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGEQRS, SGET02,
EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGELS, SGET02,
$ SLACPY, SLARHS, SLATB4, SLATMS, SQRT01,
$ SQRT01P, SQRT02, SQRT03, XLAENV
* ..
@ -388,7 +388,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -405,14 +405,20 @@
*
CALL SLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'SGEQRS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'SGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX )
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, SGELQ2, SGELQF, SGELQS, SORGL2,
EXTERNAL ALAESM, CHKXER, SGELQ2, SGELQF, SORGL2,
$ SORGLQ, SORML2, SORMLQ
* ..
* .. Scalars in Common ..
@ -140,31 +140,6 @@
CALL SGELQ2( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'SORGLQ'

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

@ -77,7 +77,7 @@
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, SGEQR2, SGEQR2P, SGEQRF,
$ SGEQRFP, SGEQRS, SORG2R, SORGQR, SORM2R,
$ SGEQRFP, SORG2R, SORGQR, SORM2R,
$ SORMQR
* ..
* .. Scalars in Common ..
@ -170,31 +170,6 @@
CALL SGEQR2P( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'SORGQR'

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

@ -235,7 +235,7 @@
DOUBLE PRECISION RESULT( NTESTS )
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRLQ, ZGELQS,
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRLQ, ZGELS,
$ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLQT01,
$ ZLQT02, ZLQT03
* ..
@ -370,7 +370,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -387,14 +387,20 @@
*
CALL ZLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'ZGELQS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'ZGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -244,7 +244,7 @@
EXTERNAL ZGENND
* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRQR, ZGEQRS,
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRQR, ZGELS,
$ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZQRT01,
$ ZQRT01P, ZQRT02, ZQRT03
* ..
@ -388,7 +388,7 @@
$ WORK, LWORK, RWORK, RESULT( 3 ) )
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
* residual.
*
@ -405,14 +405,20 @@
*
CALL ZLACPY( 'Full', M, NRHS, B, LDA, X,
$ 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 )
$ CALL ALAERH( PATH, 'ZGEQRS', INFO, 0, ' ',
$ CALL ALAERH( PATH, 'ZGELS', INFO, 0, 'N',
$ M, N, NRHS, -1, NB, IMAT,
$ NFAIL, NERRS, NOUT )
*

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

@ -76,7 +76,7 @@
$ W( NMAX ), X( NMAX )
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, ZGELQ2, ZGELQF, ZGELQS, ZUNGL2,
EXTERNAL ALAESM, CHKXER, ZGELQ2, ZGELQF, ZUNGL2,
$ ZUNGLQ, ZUNML2, ZUNMLQ
* ..
* .. Scalars in Common ..
@ -142,31 +142,6 @@
CALL ZGELQ2( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'ZUNGLQ'

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

@ -77,7 +77,7 @@
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, ZGEQR2, ZGEQR2P, ZGEQRF,
$ ZGEQRFP, ZGEQRS, ZUNG2R, ZUNGQR, ZUNM2R,
$ ZGEQRFP, ZUNG2R, ZUNGQR, ZUNM2R,
$ ZUNMQR
* ..
* .. Scalars in Common ..
@ -172,31 +172,6 @@
CALL ZGEQR2P( 2, 1, A, 1, B, W, INFO )
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
*
SRNAMT = 'ZUNGQR'