Files
lapack/SRC/cgerq2.f
T
Julie e18d437924 Making LAPACK's code eternal... no more version and date in source files.
GitHub is now enabling us to track accurately version and date.
No need for this anymore.
2021-03-25 10:16:58 -07:00

193 lines
5.2 KiB
FortranFixed

*> \brief \b CGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CGERQ2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgerq2.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgerq2.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgerq2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE CGERQ2( M, N, A, LDA, TAU, WORK, INFO )
*
* .. Scalar Arguments ..
* INTEGER INFO, LDA, M, N
* ..
* .. Array Arguments ..
* COMPLEX A( LDA, * ), TAU( * ), WORK( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> CGERQ2 computes an RQ factorization of a complex m by n matrix A:
*> A = R * Q.
*> \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 >= 0.
*> \endverbatim
*>
*> \param[in,out] A
*> \verbatim
*> A is COMPLEX array, dimension (LDA,N)
*> On entry, the m by n matrix A.
*> On exit, if m <= n, the upper triangle of the subarray
*> A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
*> if m >= n, the elements on and above the (m-n)-th subdiagonal
*> contain the m by n upper trapezoidal matrix R; the remaining
*> elements, with the array TAU, represent the unitary matrix
*> Q as a product of elementary reflectors (see Further
*> Details).
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[out] TAU
*> \verbatim
*> TAU is COMPLEX array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors (see Further
*> Details).
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX array, dimension (M)
*> \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 complexGEcomputational
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> The matrix Q is represented as a product of elementary reflectors
*>
*> Q = H(1)**H H(2)**H . . . H(k)**H, where k = min(m,n).
*>
*> Each H(i) has the form
*>
*> H(i) = I - tau * v * v**H
*>
*> where tau is a complex scalar, and v is a complex vector with
*> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; conjg(v(1:n-k+i-1)) is stored on
*> exit in A(m-k+i,1:n-k+i-1), and tau in TAU(i).
*> \endverbatim
*>
* =====================================================================
SUBROUTINE CGERQ2( M, N, A, LDA, TAU, WORK, INFO )
*
* -- LAPACK computational 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, M, N
* ..
* .. Array Arguments ..
COMPLEX A( LDA, * ), TAU( * ), WORK( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX ONE
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
* ..
* .. Local Scalars ..
INTEGER I, K
COMPLEX ALPHA
* ..
* .. External Subroutines ..
EXTERNAL CLACGV, CLARF, CLARFG, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* ..
* .. Executable Statements ..
*
* Test the input arguments
*
INFO = 0
IF( M.LT.0 ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGERQ2', -INFO )
RETURN
END IF
*
K = MIN( M, N )
*
DO 10 I = K, 1, -1
*
* Generate elementary reflector H(i) to annihilate
* A(m-k+i,1:n-k+i-1)
*
CALL CLACGV( N-K+I, A( M-K+I, 1 ), LDA )
ALPHA = A( M-K+I, N-K+I )
CALL CLARFG( N-K+I, ALPHA, A( M-K+I, 1 ), LDA,
$ TAU( I ) )
*
* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
*
A( M-K+I, N-K+I ) = ONE
CALL CLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
$ TAU( I ), A, LDA, WORK )
A( M-K+I, N-K+I ) = ALPHA
CALL CLACGV( N-K+I-1, A( M-K+I, 1 ), LDA )
10 CONTINUE
RETURN
*
* End of CGERQ2
*
END