1*> \brief \b CGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CGEQR2P + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeqr2p.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgeqr2p.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeqr2p.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INFO, LDA, M, N
25*       ..
26*       .. Array Arguments ..
27*       COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
28*       ..
29*
30*
31*> \par Purpose:
32*  =============
33*>
34*> \verbatim
35*>
36*> CGEQR2P computes a QR factorization of a complex m-by-n matrix A:
37*>
38*>    A = Q * ( R ),
39*>            ( 0 )
40*>
41*> where:
42*>
43*>    Q is a m-by-m orthogonal matrix;
44*>    R is an upper-triangular n-by-n matrix with nonnegative diagonal
45*>    entries;
46*>    0 is a (m-n)-by-n zero matrix, if m > n.
47*>
48*> \endverbatim
49*
50*  Arguments:
51*  ==========
52*
53*> \param[in] M
54*> \verbatim
55*>          M is INTEGER
56*>          The number of rows of the matrix A.  M >= 0.
57*> \endverbatim
58*>
59*> \param[in] N
60*> \verbatim
61*>          N is INTEGER
62*>          The number of columns of the matrix A.  N >= 0.
63*> \endverbatim
64*>
65*> \param[in,out] A
66*> \verbatim
67*>          A is COMPLEX array, dimension (LDA,N)
68*>          On entry, the m by n matrix A.
69*>          On exit, the elements on and above the diagonal of the array
70*>          contain the min(m,n) by n upper trapezoidal matrix R (R is
71*>          upper triangular if m >= n). The diagonal entries of R are
72*>          real and nonnegative; the elements below the diagonal,
73*>          with the array TAU, represent the unitary matrix Q as a
74*>          product of elementary reflectors (see Further Details).
75*> \endverbatim
76*>
77*> \param[in] LDA
78*> \verbatim
79*>          LDA is INTEGER
80*>          The leading dimension of the array A.  LDA >= max(1,M).
81*> \endverbatim
82*>
83*> \param[out] TAU
84*> \verbatim
85*>          TAU is COMPLEX array, dimension (min(M,N))
86*>          The scalar factors of the elementary reflectors (see Further
87*>          Details).
88*> \endverbatim
89*>
90*> \param[out] WORK
91*> \verbatim
92*>          WORK is COMPLEX array, dimension (N)
93*> \endverbatim
94*>
95*> \param[out] INFO
96*> \verbatim
97*>          INFO is INTEGER
98*>          = 0: successful exit
99*>          < 0: if INFO = -i, the i-th argument had an illegal value
100*> \endverbatim
101*
102*  Authors:
103*  ========
104*
105*> \author Univ. of Tennessee
106*> \author Univ. of California Berkeley
107*> \author Univ. of Colorado Denver
108*> \author NAG Ltd.
109*
110*> \ingroup complexGEcomputational
111*
112*> \par Further Details:
113*  =====================
114*>
115*> \verbatim
116*>
117*>  The matrix Q is represented as a product of elementary reflectors
118*>
119*>     Q = H(1) H(2) . . . H(k), where k = min(m,n).
120*>
121*>  Each H(i) has the form
122*>
123*>     H(i) = I - tau * v * v**H
124*>
125*>  where tau is a complex scalar, and v is a complex vector with
126*>  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
127*>  and tau in TAU(i).
128*>
129*> See Lapack Working Note 203 for details
130*> \endverbatim
131*>
132*  =====================================================================
133      SUBROUTINE CGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
134*
135*  -- LAPACK computational routine --
136*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
137*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138*
139*     .. Scalar Arguments ..
140      INTEGER            INFO, LDA, M, N
141*     ..
142*     .. Array Arguments ..
143      COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
144*     ..
145*
146*  =====================================================================
147*
148*     .. Parameters ..
149      COMPLEX            ONE
150      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
151*     ..
152*     .. Local Scalars ..
153      INTEGER            I, K
154      COMPLEX            ALPHA
155*     ..
156*     .. External Subroutines ..
157      EXTERNAL           CLARF, CLARFGP, XERBLA
158*     ..
159*     .. Intrinsic Functions ..
160      INTRINSIC          CONJG, MAX, MIN
161*     ..
162*     .. Executable Statements ..
163*
164*     Test the input arguments
165*
166      INFO = 0
167      IF( M.LT.0 ) THEN
168         INFO = -1
169      ELSE IF( N.LT.0 ) THEN
170         INFO = -2
171      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
172         INFO = -4
173      END IF
174      IF( INFO.NE.0 ) THEN
175         CALL XERBLA( 'CGEQR2P', -INFO )
176         RETURN
177      END IF
178*
179      K = MIN( M, N )
180*
181      DO 10 I = 1, K
182*
183*        Generate elementary reflector H(i) to annihilate A(i+1:m,i)
184*
185         CALL CLARFGP( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
186     $                TAU( I ) )
187         IF( I.LT.N ) THEN
188*
189*           Apply H(i)**H to A(i:m,i+1:n) from the left
190*
191            ALPHA = A( I, I )
192            A( I, I ) = ONE
193            CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
194     $                  CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
195            A( I, I ) = ALPHA
196         END IF
197   10 CONTINUE
198      RETURN
199*
200*     End of CGEQR2P
201*
202      END
203