001:       SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            INFO, LDA, M, N
010: *     ..
011: *     .. Array Arguments ..
012:       COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
013: *     ..
014: *
015: *  Purpose
016: *  =======
017: *
018: *  CGELQ2 computes an LQ factorization of a complex m by n matrix A:
019: *  A = L * Q.
020: *
021: *  Arguments
022: *  =========
023: *
024: *  M       (input) INTEGER
025: *          The number of rows of the matrix A.  M >= 0.
026: *
027: *  N       (input) INTEGER
028: *          The number of columns of the matrix A.  N >= 0.
029: *
030: *  A       (input/output) COMPLEX array, dimension (LDA,N)
031: *          On entry, the m by n matrix A.
032: *          On exit, the elements on and below the diagonal of the array
033: *          contain the m by min(m,n) lower trapezoidal matrix L (L is
034: *          lower triangular if m <= n); the elements above the diagonal,
035: *          with the array TAU, represent the unitary matrix Q as a
036: *          product of elementary reflectors (see Further Details).
037: *
038: *  LDA     (input) INTEGER
039: *          The leading dimension of the array A.  LDA >= max(1,M).
040: *
041: *  TAU     (output) COMPLEX array, dimension (min(M,N))
042: *          The scalar factors of the elementary reflectors (see Further
043: *          Details).
044: *
045: *  WORK    (workspace) COMPLEX array, dimension (M)
046: *
047: *  INFO    (output) INTEGER
048: *          = 0: successful exit
049: *          < 0: if INFO = -i, the i-th argument had an illegal value
050: *
051: *  Further Details
052: *  ===============
053: *
054: *  The matrix Q is represented as a product of elementary reflectors
055: *
056: *     Q = H(k)' . . . H(2)' H(1)', where k = min(m,n).
057: *
058: *  Each H(i) has the form
059: *
060: *     H(i) = I - tau * v * v'
061: *
062: *  where tau is a complex scalar, and v is a complex vector with
063: *  v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
064: *  A(i,i+1:n), and tau in TAU(i).
065: *
066: *  =====================================================================
067: *
068: *     .. Parameters ..
069:       COMPLEX            ONE
070:       PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
071: *     ..
072: *     .. Local Scalars ..
073:       INTEGER            I, K
074:       COMPLEX            ALPHA
075: *     ..
076: *     .. External Subroutines ..
077:       EXTERNAL           CLACGV, CLARF, CLARFP, XERBLA
078: *     ..
079: *     .. Intrinsic Functions ..
080:       INTRINSIC          MAX, MIN
081: *     ..
082: *     .. Executable Statements ..
083: *
084: *     Test the input arguments
085: *
086:       INFO = 0
087:       IF( M.LT.0 ) THEN
088:          INFO = -1
089:       ELSE IF( N.LT.0 ) THEN
090:          INFO = -2
091:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
092:          INFO = -4
093:       END IF
094:       IF( INFO.NE.0 ) THEN
095:          CALL XERBLA( 'CGELQ2', -INFO )
096:          RETURN
097:       END IF
098: *
099:       K = MIN( M, N )
100: *
101:       DO 10 I = 1, K
102: *
103: *        Generate elementary reflector H(i) to annihilate A(i,i+1:n)
104: *
105:          CALL CLACGV( N-I+1, A( I, I ), LDA )
106:          ALPHA = A( I, I )
107:          CALL CLARFP( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
108:      $                TAU( I ) )
109:          IF( I.LT.M ) THEN
110: *
111: *           Apply H(i) to A(i+1:m,i:n) from the right
112: *
113:             A( I, I ) = ONE
114:             CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
115:      $                  A( I+1, I ), LDA, WORK )
116:          END IF
117:          A( I, I ) = ALPHA
118:          CALL CLACGV( N-I+1, A( I, I ), LDA )
119:    10 CONTINUE
120:       RETURN
121: *
122: *     End of CGELQ2
123: *
124:       END
125: