1*> \brief \b SGEQL2 computes the QL 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 SGEQL2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeql2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeql2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeql2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SGEQL2( 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*> SGEQL2 computes a QL factorization of a real m by n matrix A:
37*> A = Q * L.
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 REAL array, dimension (LDA,N)
58*>          On entry, the m by n matrix A.
59*>          On exit, if m >= n, the lower triangle of the subarray
60*>          A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
61*>          if m <= n, the elements on and below the (n-m)-th
62*>          superdiagonal contain the m by n lower trapezoidal matrix L;
63*>          the remaining elements, with the array TAU, represent the
64*>          orthogonal matrix Q as a product of elementary reflectors
65*>          (see Further 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 REAL 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 REAL array, dimension (N)
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*> \ingroup realGEcomputational
102*
103*> \par Further Details:
104*  =====================
105*>
106*> \verbatim
107*>
108*>  The matrix Q is represented as a product of elementary reflectors
109*>
110*>     Q = H(k) . . . H(2) H(1), where k = min(m,n).
111*>
112*>  Each H(i) has the form
113*>
114*>     H(i) = I - tau * v * v**T
115*>
116*>  where tau is a real scalar, and v is a real vector with
117*>  v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
118*>  A(1:m-k+i-1,n-k+i), and tau in TAU(i).
119*> \endverbatim
120*>
121*  =====================================================================
122      SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO )
123*
124*  -- LAPACK computational routine --
125*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
126*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*
128*     .. Scalar Arguments ..
129      INTEGER            INFO, LDA, M, N
130*     ..
131*     .. Array Arguments ..
132      REAL               A( LDA, * ), TAU( * ), WORK( * )
133*     ..
134*
135*  =====================================================================
136*
137*     .. Parameters ..
138      REAL               ONE
139      PARAMETER          ( ONE = 1.0E+0 )
140*     ..
141*     .. Local Scalars ..
142      INTEGER            I, K
143      REAL               AII
144*     ..
145*     .. External Subroutines ..
146      EXTERNAL           SLARF, SLARFG, XERBLA
147*     ..
148*     .. Intrinsic Functions ..
149      INTRINSIC          MAX, MIN
150*     ..
151*     .. Executable Statements ..
152*
153*     Test the input arguments
154*
155      INFO = 0
156      IF( M.LT.0 ) THEN
157         INFO = -1
158      ELSE IF( N.LT.0 ) THEN
159         INFO = -2
160      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
161         INFO = -4
162      END IF
163      IF( INFO.NE.0 ) THEN
164         CALL XERBLA( 'SGEQL2', -INFO )
165         RETURN
166      END IF
167*
168      K = MIN( M, N )
169*
170      DO 10 I = K, 1, -1
171*
172*        Generate elementary reflector H(i) to annihilate
173*        A(1:m-k+i-1,n-k+i)
174*
175         CALL SLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1,
176     $                TAU( I ) )
177*
178*        Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left
179*
180         AII = A( M-K+I, N-K+I )
181         A( M-K+I, N-K+I ) = ONE
182         CALL SLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, TAU( I ),
183     $               A, LDA, WORK )
184         A( M-K+I, N-K+I ) = AII
185   10 CONTINUE
186      RETURN
187*
188*     End of SGEQL2
189*
190      END
191