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