001:       SUBROUTINE CORE_CGELQT( M, N, IB, A, LDA, T, LDT,
002:      $                       TAU, WORK, INFO )
003: 
004: *********************************************************************
005: *     PLASMA core_blas routine (version 2.1.0)                      *
006: *     Author: Hatem Ltaief                                          *
007: *     Release Date: November, 15th 2009                             *
008: *     PLASMA is a software package provided by Univ. of Tennessee,  *
009: *     Univ. of California Berkeley and Univ. of Colorado Denver.    *
010: *********************************************************************
011: *
012: *     .. Scalar Arguments ..
013:       INTEGER            M, N, IB, LDA, LDT, INFO
014: *     ..
015: *     .. Array Arguments ..
016:       COMPLEX            A( LDA, * ), T( LDT, * )
017:       COMPLEX            TAU( * ), WORK( * )
018: *     ..
019: *
020: *  Purpose
021: *  =======
022: *
023: *  CORE_CGELQT computes a LQ factorization of a complex M-by-N tile A:
024: *  A = L * Q.
025: *
026: *  Arguments
027: *  =========
028: *
029: *  M       (input) INTEGER
030: *          The number of rows of the tile A.  M >= 0.
031: *
032: *  N       (input) INTEGER
033: *          The number of columns of the tile A.  N >= 0.
034: *
035: *  IB      (input) INTEGER
036: *          The inner-blocking size.  IB >= 0.
037: *
038: *  A       (input/output) COMPLEX array, dimension (LDA,N)
039: *          On entry, the M-by-N tile A.
040: *          On exit, the elements on and below the diagonal of the array
041: *          contain the M-by-min(M,N) lower trapezoidal tile L (L is
042: *          lower triangular if M <= N); the elements above the diagonal,
043: *          with the array TAU, represent the unitary tile Q as a
044: *          product of elementary reflectors (see Further Details).
045: *
046: *  LDA     (input) INTEGER
047: *          The leading dimension of the array A.  LDA >= max(1,M).
048: *
049: *  T       (output) COMPLEX array, dimension (LDT,N)
050: *          The IB-by-N triangular factor T of the block reflector.
051: *          T is upper triangular by block (economic storage);
052: *          The rest of the array is not referenced.
053: *
054: *  LDT     (input) INTEGER
055: *          The leading dimension of the array T. LDT >= IB.
056: *
057: *  TAU     (output) COMPLEX array, dimension (min(M,N))
058: *          The scalar factors of the elementary reflectors (see Further
059: *          Details).
060: *
061: *  WORK    (workspace) COMPLEX array, dimension (M)
062: *
063: *  INFO    (output) INTEGER
064: *          = 0:  successful exit
065: *          < 0:  if INFO = -i, the i-th argument had an illegal value
066: *
067: *  Further Details
068: *  ===============
069: *
070: *  The tile Q is represented as a product of elementary reflectors
071: *
072: *     Q = H(k)' . . . H(2)' H(1)', where k = min(M,N).
073: *
074: *  Each H(i) has the form
075: *
076: *     H(i) = I - tau * v * v'
077: *
078: *  where tau is a complex scalar, and v is a complex vector with
079: *  v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
080: *  A(i,i+1:n), and tau in TAU(i).
081: *
082: *  =====================================================================
083: *
084: *     .. Local Scalars ..
085:       INTEGER            I, K, SB, IINFO
086: *     ..
087: *     .. External Subroutines ..
088:       EXTERNAL           XERBLA, CGELQ2, CLARFT, CORE_CUNMLQ
089: *     ..
090: *     .. Intrinsic Functions ..
091:       INTRINSIC          MAX, MIN
092: *     ..
093: *     Test the input arguments
094:       INFO = 0
095:       IF( M.LT.0 ) THEN
096:          INFO = -1
097:       ELSE IF( N.LT.0 ) THEN
098:          INFO = -2
099:       ELSE IF( IB.LT.0 ) THEN
100:          INFO = -3
101:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
102:          INFO = -5
103:       ELSE IF( LDT.LT.MAX( 1, IB ) ) THEN
104:          INFO = -7
105:       END IF
106:       IF( INFO.NE.0 ) THEN
107:          CALL XERBLA( 'CORE_CGELQT', -INFO )
108:          RETURN
109:       END IF
110: *
111: *     Quick return if possible.
112: *
113:       IF( M.EQ.0 .OR. N.EQ.0 .OR. IB.EQ.0 )
114:      $   RETURN
115: *
116:       K = MIN( M, N )
117: *
118:       DO 10 I = 1, K, IB
119:          SB = MIN( IB, K-I+1 )
120:          CALL CGELQ2( SB, N-I+1, A( I, I ), LDA, TAU( I ), WORK, IINFO )
121: *
122:          CALL CLARFT( 'Forward', 'Rowwise', N-I+1, SB,
123:      $                A( I, I ),LDA, TAU( I ),
124:      $                T( 1, I ), LDT )
125: *
126:          IF ( M.GT.( I+IB-1 ) ) THEN   
127:              CALL CORE_CUNMLQ( 'Right', 'ConjTranspose',
128:      $                        M-I+1-SB, N-I+1, SB, SB,
129:      $                        A( I, I ), LDA,
130:      $                        T( 1, I ), LDT,
131:      $                        A( I+SB, I ), LDA,
132:      $                        WORK, M-I+1-SB, IINFO )
133:          ENDIF
134:  10   CONTINUE
135: *
136:       RETURN
137: *
138: *     End of CORE_CGELQT.
139: *
140:       END
141: