001:       SUBROUTINE CTZRQF( M, N, A, LDA, TAU, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       INTEGER            INFO, LDA, M, N
009: *     ..
010: *     .. Array Arguments ..
011:       COMPLEX            A( LDA, * ), TAU( * )
012: *     ..
013: *
014: *  Purpose
015: *  =======
016: *
017: *  This routine is deprecated and has been replaced by routine CTZRZF.
018: *
019: *  CTZRQF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A
020: *  to upper triangular form by means of unitary transformations.
021: *
022: *  The upper trapezoidal matrix A is factored as
023: *
024: *     A = ( R  0 ) * Z,
025: *
026: *  where Z is an N-by-N unitary matrix and R is an M-by-M upper
027: *  triangular matrix.
028: *
029: *  Arguments
030: *  =========
031: *
032: *  M       (input) INTEGER
033: *          The number of rows of the matrix A.  M >= 0.
034: *
035: *  N       (input) INTEGER
036: *          The number of columns of the matrix A.  N >= M.
037: *
038: *  A       (input/output) COMPLEX array, dimension (LDA,N)
039: *          On entry, the leading M-by-N upper trapezoidal part of the
040: *          array A must contain the matrix to be factorized.
041: *          On exit, the leading M-by-M upper triangular part of A
042: *          contains the upper triangular matrix R, and elements M+1 to
043: *          N of the first M rows of A, with the array TAU, represent the
044: *          unitary matrix Z as a product of M elementary reflectors.
045: *
046: *  LDA     (input) INTEGER
047: *          The leading dimension of the array A.  LDA >= max(1,M).
048: *
049: *  TAU     (output) COMPLEX array, dimension (M)
050: *          The scalar factors of the elementary reflectors.
051: *
052: *  INFO    (output) INTEGER
053: *          = 0: successful exit
054: *          < 0: if INFO = -i, the i-th argument had an illegal value
055: *
056: *  Further Details
057: *  ===============
058: *
059: *  The  factorization is obtained by Householder's method.  The kth
060: *  transformation matrix, Z( k ), whose conjugate transpose is used to
061: *  introduce zeros into the (m - k + 1)th row of A, is given in the form
062: *
063: *     Z( k ) = ( I     0   ),
064: *              ( 0  T( k ) )
065: *
066: *  where
067: *
068: *     T( k ) = I - tau*u( k )*u( k )',   u( k ) = (   1    ),
069: *                                                 (   0    )
070: *                                                 ( z( k ) )
071: *
072: *  tau is a scalar and z( k ) is an ( n - m ) element vector.
073: *  tau and z( k ) are chosen to annihilate the elements of the kth row
074: *  of X.
075: *
076: *  The scalar tau is returned in the kth element of TAU and the vector
077: *  u( k ) in the kth row of A, such that the elements of z( k ) are
078: *  in  a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
079: *  the upper triangular part of A.
080: *
081: *  Z is given by
082: *
083: *     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
084: *
085: * =====================================================================
086: *
087: *     .. Parameters ..
088:       COMPLEX            CONE, CZERO
089:       PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ),
090:      $                   CZERO = ( 0.0E+0, 0.0E+0 ) )
091: *     ..
092: *     .. Local Scalars ..
093:       INTEGER            I, K, M1
094:       COMPLEX            ALPHA
095: *     ..
096: *     .. Intrinsic Functions ..
097:       INTRINSIC          CONJG, MAX, MIN
098: *     ..
099: *     .. External Subroutines ..
100:       EXTERNAL           CAXPY, CCOPY, CGEMV, CGERC, CLACGV, CLARFG,
101:      $                   XERBLA
102: *     ..
103: *     .. Executable Statements ..
104: *
105: *     Test the input parameters.
106: *
107:       INFO = 0
108:       IF( M.LT.0 ) THEN
109:          INFO = -1
110:       ELSE IF( N.LT.M ) THEN
111:          INFO = -2
112:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
113:          INFO = -4
114:       END IF
115:       IF( INFO.NE.0 ) THEN
116:          CALL XERBLA( 'CTZRQF', -INFO )
117:          RETURN
118:       END IF
119: *
120: *     Perform the factorization.
121: *
122:       IF( M.EQ.0 )
123:      $   RETURN
124:       IF( M.EQ.N ) THEN
125:          DO 10 I = 1, N
126:             TAU( I ) = CZERO
127:    10    CONTINUE
128:       ELSE
129:          M1 = MIN( M+1, N )
130:          DO 20 K = M, 1, -1
131: *
132: *           Use a Householder reflection to zero the kth row of A.
133: *           First set up the reflection.
134: *
135:             A( K, K ) = CONJG( A( K, K ) )
136:             CALL CLACGV( N-M, A( K, M1 ), LDA )
137:             ALPHA = A( K, K )
138:             CALL CLARFG( N-M+1, ALPHA, A( K, M1 ), LDA, TAU( K ) )
139:             A( K, K ) = ALPHA
140:             TAU( K ) = CONJG( TAU( K ) )
141: *
142:             IF( TAU( K ).NE.CZERO .AND. K.GT.1 ) THEN
143: *
144: *              We now perform the operation  A := A*P( k )'.
145: *
146: *              Use the first ( k - 1 ) elements of TAU to store  a( k ),
147: *              where  a( k ) consists of the first ( k - 1 ) elements of
148: *              the  kth column  of  A.  Also  let  B  denote  the  first
149: *              ( k - 1 ) rows of the last ( n - m ) columns of A.
150: *
151:                CALL CCOPY( K-1, A( 1, K ), 1, TAU, 1 )
152: *
153: *              Form   w = a( k ) + B*z( k )  in TAU.
154: *
155:                CALL CGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ),
156:      $                     LDA, A( K, M1 ), LDA, CONE, TAU, 1 )
157: *
158: *              Now form  a( k ) := a( k ) - conjg(tau)*w
159: *              and       B      := B      - conjg(tau)*w*z( k )'.
160: *
161:                CALL CAXPY( K-1, -CONJG( TAU( K ) ), TAU, 1, A( 1, K ),
162:      $                     1 )
163:                CALL CGERC( K-1, N-M, -CONJG( TAU( K ) ), TAU, 1,
164:      $                     A( K, M1 ), LDA, A( 1, M1 ), LDA )
165:             END IF
166:    20    CONTINUE
167:       END IF
168: *
169:       RETURN
170: *
171: *     End of CTZRQF
172: *
173:       END
174: