| @@ -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 | |||||