1      SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO )
2*
3*  -- LAPACK routine (version 3.0) --
4*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5*     Courant Institute, Argonne National Lab, and Rice University
6*     February 29, 1992
7*
8*     .. Scalar Arguments ..
9      INTEGER            INFO, LDA, M, N
10*     ..
11*     .. Array Arguments ..
12      REAL               A( LDA, * ), TAU( * ), WORK( * )
13*     ..
14*
15*  Purpose
16*  =======
17*
18*  SGELQ2 computes an LQ factorization of a real m by n matrix A:
19*  A = L * Q.
20*
21*  Arguments
22*  =========
23*
24*  M       (input) INTEGER
25*          The number of rows of the matrix A.  M >= 0.
26*
27*  N       (input) INTEGER
28*          The number of columns of the matrix A.  N >= 0.
29*
30*  A       (input/output) REAL array, dimension (LDA,N)
31*          On entry, the m by n matrix A.
32*          On exit, the elements on and below the diagonal of the array
33*          contain the m by min(m,n) lower trapezoidal matrix L (L is
34*          lower triangular if m <= n); the elements above the diagonal,
35*          with the array TAU, represent the orthogonal matrix Q as a
36*          product of elementary reflectors (see Further Details).
37*
38*  LDA     (input) INTEGER
39*          The leading dimension of the array A.  LDA >= max(1,M).
40*
41*  TAU     (output) REAL array, dimension (min(M,N))
42*          The scalar factors of the elementary reflectors (see Further
43*          Details).
44*
45*  WORK    (workspace) REAL array, dimension (M)
46*
47*  INFO    (output) INTEGER
48*          = 0: successful exit
49*          < 0: if INFO = -i, the i-th argument had an illegal value
50*
51*  Further Details
52*  ===============
53*
54*  The matrix Q is represented as a product of elementary reflectors
55*
56*     Q = H(k) . . . H(2) H(1), where k = min(m,n).
57*
58*  Each H(i) has the form
59*
60*     H(i) = I - tau * v * v'
61*
62*  where tau is a real scalar, and v is a real vector with
63*  v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
64*  and tau in TAU(i).
65*
66*  =====================================================================
67*
68*     .. Parameters ..
69      REAL               ONE
70      PARAMETER          ( ONE = 1.0E+0 )
71*     ..
72*     .. Local Scalars ..
73      INTEGER            I, K
74      REAL               AII
75*     ..
76*     .. External Subroutines ..
77      EXTERNAL           SLARF, SLARFG, XERBLA
78*     ..
79*     .. Intrinsic Functions ..
80      INTRINSIC          MAX, MIN
81*     ..
82*     .. Executable Statements ..
83*
84*     Test the input arguments
85*
86      INFO = 0
87      IF( M.LT.0 ) THEN
88         INFO = -1
89      ELSE IF( N.LT.0 ) THEN
90         INFO = -2
91      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
92         INFO = -4
93      END IF
94      IF( INFO.NE.0 ) THEN
95         CALL XERBLA( 'SGELQ2', -INFO )
96         RETURN
97      END IF
98*
99      K = MIN( M, N )
100*
101      DO 10 I = 1, K
102*
103*        Generate elementary reflector H(i) to annihilate A(i,i+1:n)
104*
105         CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
106     $                TAU( I ) )
107         IF( I.LT.M ) THEN
108*
109*           Apply H(i) to A(i+1:m,i:n) from the right
110*
111            AII = A( I, I )
112            A( I, I ) = ONE
113            CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
114     $                  A( I+1, I ), LDA, WORK )
115            A( I, I ) = AII
116         END IF
117   10 CONTINUE
118      RETURN
119*
120*     End of SGELQ2
121*
122      END
123