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