Move ?GELQS and ?GEQRS from TESTING/LIN to DEPRECATED (Reference-LAPACK PR 900)
This commit is contained in:
Martin Kroeker
GitHub
parent
ab3d6a6604
commit
bf0fa06a37
|
|
@ -0,0 +1,196 @@
|
|||
*> \brief \b CGELQS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE CGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* COMPLEX A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Compute a minimum-norm solution
|
||||
*> min || A*X - B ||
|
||||
*> using the LQ factorization
|
||||
*> A = L*Q
|
||||
*> computed by CGELQF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. N >= M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is COMPLEX array, dimension (LDA,N)
|
||||
*> Details of the LQ factorization of the original matrix A as
|
||||
*> returned by CGELQF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is COMPLEX array, dimension (M)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is COMPLEX array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= N.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is COMPLEX array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup complex_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE CGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX CZERO, CONE
|
||||
PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
|
||||
$ CONE = ( 1.0E+0, 0.0E+0 ) )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CLASET, CTRSM, CUNMLQ, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. M.GT.N ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'CGELQS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* Solve L*X = B(1:m,:)
|
||||
*
|
||||
CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
|
||||
$ CONE, A, LDA, B, LDB )
|
||||
*
|
||||
* Set B(m+1:n,:) to zero
|
||||
*
|
||||
IF( M.LT.N )
|
||||
$ CALL CLASET( 'Full', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ),
|
||||
$ LDB )
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL CUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M, A, LDA,
|
||||
$ TAU, B, LDB, WORK, LWORK, INFO )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of CGELQS
|
||||
*
|
||||
END
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
*> \brief \b CGEQRS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE CGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* COMPLEX A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Solve the least squares problem
|
||||
*> min || A*X - B ||
|
||||
*> using the QR factorization
|
||||
*> A = Q*R
|
||||
*> computed by CGEQRF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. M >= N >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is COMPLEX array, dimension (LDA,N)
|
||||
*> Details of the QR factorization of the original matrix A as
|
||||
*> returned by CGEQRF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is COMPLEX array, dimension (N)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is COMPLEX array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is COMPLEX array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup complex_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE CGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX ONE
|
||||
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CTRSM, CUNMQR, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input arguments.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'CGEQRS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, A, LDA,
|
||||
$ TAU, B, LDB, WORK, LWORK, INFO )
|
||||
*
|
||||
* Solve R*X = B(1:n,:)
|
||||
*
|
||||
CALL CTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, NRHS,
|
||||
$ ONE, A, LDA, B, LDB )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of CGEQRS
|
||||
*
|
||||
END
|
||||
|
|
@ -0,0 +1,194 @@
|
|||
*> \brief \b DGELQS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE DGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Compute a minimum-norm solution
|
||||
*> min || A*X - B ||
|
||||
*> using the LQ factorization
|
||||
*> A = L*Q
|
||||
*> computed by DGELQF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. N >= M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is DOUBLE PRECISION array, dimension (LDA,N)
|
||||
*> Details of the LQ factorization of the original matrix A as
|
||||
*> returned by DGELQF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is DOUBLE PRECISION array, dimension (M)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= N.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is DOUBLE PRECISION array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup double_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DLASET, DORMLQ, DTRSM, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. M.GT.N ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DGELQS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* Solve L*X = B(1:m,:)
|
||||
*
|
||||
CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
|
||||
$ ONE, A, LDA, B, LDB )
|
||||
*
|
||||
* Set B(m+1:n,:) to zero
|
||||
*
|
||||
IF( M.LT.N )
|
||||
$ CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB,
|
||||
$ WORK, LWORK, INFO )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DGELQS
|
||||
*
|
||||
END
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
*> \brief \b DGEQRS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE DGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Solve the least squares problem
|
||||
*> min || A*X - B ||
|
||||
*> using the QR factorization
|
||||
*> A = Q*R
|
||||
*> computed by DGEQRF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. M >= N >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is DOUBLE PRECISION array, dimension (LDA,N)
|
||||
*> Details of the QR factorization of the original matrix A as
|
||||
*> returned by DGEQRF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is DOUBLE PRECISION array, dimension (N)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is DOUBLE PRECISION array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup double_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ONE
|
||||
PARAMETER ( ONE = 1.0D+0 )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DORMQR, DTRSM, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input arguments.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DGEQRS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL DORMQR( 'Left', 'Transpose', M, NRHS, N, A, LDA, TAU, B, LDB,
|
||||
$ WORK, LWORK, INFO )
|
||||
*
|
||||
* Solve R*X = B(1:n,:)
|
||||
*
|
||||
CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, NRHS,
|
||||
$ ONE, A, LDA, B, LDB )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DGEQRS
|
||||
*
|
||||
END
|
||||
|
|
@ -0,0 +1,194 @@
|
|||
*> \brief \b SGELQS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE SGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* REAL A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Compute a minimum-norm solution
|
||||
*> min || A*X - B ||
|
||||
*> using the LQ factorization
|
||||
*> A = L*Q
|
||||
*> computed by SGELQF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. N >= M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is REAL array, dimension (LDA,N)
|
||||
*> Details of the LQ factorization of the original matrix A as
|
||||
*> returned by SGELQF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is REAL array, dimension (M)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is REAL array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= N.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is REAL array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup single_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE SGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
REAL A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
REAL ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL SLASET, SORMLQ, STRSM, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. M.GT.N ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'SGELQS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* Solve L*X = B(1:m,:)
|
||||
*
|
||||
CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
|
||||
$ ONE, A, LDA, B, LDB )
|
||||
*
|
||||
* Set B(m+1:n,:) to zero
|
||||
*
|
||||
IF( M.LT.N )
|
||||
$ CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB,
|
||||
$ WORK, LWORK, INFO )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of SGELQS
|
||||
*
|
||||
END
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
*> \brief \b SGEQRS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE SGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* REAL A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Solve the least squares problem
|
||||
*> min || A*X - B ||
|
||||
*> using the QR factorization
|
||||
*> A = Q*R
|
||||
*> computed by SGEQRF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. M >= N >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is REAL array, dimension (LDA,N)
|
||||
*> Details of the QR factorization of the original matrix A as
|
||||
*> returned by SGEQRF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is REAL array, dimension (N)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is REAL array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is REAL array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup single_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE SGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
REAL A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
REAL ONE
|
||||
PARAMETER ( ONE = 1.0E+0 )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL SORMQR, STRSM, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input arguments.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'SGEQRS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL SORMQR( 'Left', 'Transpose', M, NRHS, N, A, LDA, TAU, B, LDB,
|
||||
$ WORK, LWORK, INFO )
|
||||
*
|
||||
* Solve R*X = B(1:n,:)
|
||||
*
|
||||
CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, NRHS,
|
||||
$ ONE, A, LDA, B, LDB )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of SGEQRS
|
||||
*
|
||||
END
|
||||
|
|
@ -0,0 +1,196 @@
|
|||
*> \brief \b ZGELQS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE ZGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* COMPLEX*16 A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Compute a minimum-norm solution
|
||||
*> min || A*X - B ||
|
||||
*> using the LQ factorization
|
||||
*> A = L*Q
|
||||
*> computed by ZGELQF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. N >= M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is COMPLEX*16 array, dimension (LDA,N)
|
||||
*> Details of the LQ factorization of the original matrix A as
|
||||
*> returned by ZGELQF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is COMPLEX*16 array, dimension (M)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is COMPLEX*16 array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= N.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is COMPLEX*16 array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup complex16_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE ZGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX*16 CZERO, CONE
|
||||
PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
|
||||
$ CONE = ( 1.0D+0, 0.0D+0 ) )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL XERBLA, ZLASET, ZTRSM, ZUNMLQ
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. M.GT.N ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'ZGELQS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* Solve L*X = B(1:m,:)
|
||||
*
|
||||
CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
|
||||
$ CONE, A, LDA, B, LDB )
|
||||
*
|
||||
* Set B(m+1:n,:) to zero
|
||||
*
|
||||
IF( M.LT.N )
|
||||
$ CALL ZLASET( 'Full', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ),
|
||||
$ LDB )
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL ZUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M, A, LDA,
|
||||
$ TAU, B, LDB, WORK, LWORK, INFO )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of ZGELQS
|
||||
*
|
||||
END
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
*> \brief \b ZGEQRS
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE ZGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
* INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* COMPLEX*16 A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
* $ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Solve the least squares problem
|
||||
*> min || A*X - B ||
|
||||
*> using the QR factorization
|
||||
*> A = Q*R
|
||||
*> computed by ZGEQRF.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] M
|
||||
*> \verbatim
|
||||
*> M is INTEGER
|
||||
*> The number of rows of the matrix A. M >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The number of columns of the matrix A. M >= N >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] NRHS
|
||||
*> \verbatim
|
||||
*> NRHS is INTEGER
|
||||
*> The number of columns of B. NRHS >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is COMPLEX*16 array, dimension (LDA,N)
|
||||
*> Details of the QR factorization of the original matrix A as
|
||||
*> returned by ZGEQRF.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TAU
|
||||
*> \verbatim
|
||||
*> TAU is COMPLEX*16 array, dimension (N)
|
||||
*> Details of the orthogonal matrix Q.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] B
|
||||
*> \verbatim
|
||||
*> B is COMPLEX*16 array, dimension (LDB,NRHS)
|
||||
*> On entry, the m-by-nrhs right hand side matrix B.
|
||||
*> On exit, the n-by-nrhs solution matrix X.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> The leading dimension of the array B. LDB >= M.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] WORK
|
||||
*> \verbatim
|
||||
*> WORK is COMPLEX*16 array, dimension (LWORK)
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LWORK
|
||||
*> \verbatim
|
||||
*> LWORK is INTEGER
|
||||
*> The length of the array WORK. LWORK must be at least NRHS,
|
||||
*> and should be at least NRHS*NB, where NB is the block size
|
||||
*> for this environment.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Univ. of Tennessee
|
||||
*> \author Univ. of California Berkeley
|
||||
*> \author Univ. of Colorado Denver
|
||||
*> \author NAG Ltd.
|
||||
*
|
||||
*> \ingroup complex16_lin
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE ZGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
*
|
||||
* -- LAPACK test routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( LDA, * ), B( LDB, * ), TAU( * ),
|
||||
$ WORK( LWORK )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX*16 ONE
|
||||
PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL XERBLA, ZTRSM, ZUNMQR
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input arguments.
|
||||
*
|
||||
INFO = 0
|
||||
IF( M.LT.0 ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( NRHS.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -5
|
||||
ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
|
||||
INFO = -8
|
||||
ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 )
|
||||
$ THEN
|
||||
INFO = -10
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'ZGEQRS', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible
|
||||
*
|
||||
IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 )
|
||||
$ RETURN
|
||||
*
|
||||
* B := Q' * B
|
||||
*
|
||||
CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, A, LDA,
|
||||
$ TAU, B, LDB, WORK, LWORK, INFO )
|
||||
*
|
||||
* Solve R*X = B(1:n,:)
|
||||
*
|
||||
CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, NRHS,
|
||||
$ ONE, A, LDA, B, LDB )
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of ZGEQRS
|
||||
*
|
||||
END
|
||||
Loading…
Reference in New Issue