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