1*> \brief \b DGEQRF
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DGEQRF + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqrf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqrf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqrf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INFO, LDA, LWORK, 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*> DGEQRF computes a QR factorization of a real 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;
45*>    0 is a (M-N)-by-N zero matrix, if M > N.
46*>
47*> \endverbatim
48*
49*  Arguments:
50*  ==========
51*
52*> \param[in] M
53*> \verbatim
54*>          M is INTEGER
55*>          The number of rows of the matrix A.  M >= 0.
56*> \endverbatim
57*>
58*> \param[in] N
59*> \verbatim
60*>          N is INTEGER
61*>          The number of columns of the matrix A.  N >= 0.
62*> \endverbatim
63*>
64*> \param[in,out] A
65*> \verbatim
66*>          A is DOUBLE PRECISION array, dimension (LDA,N)
67*>          On entry, the M-by-N matrix A.
68*>          On exit, the elements on and above the diagonal of the array
69*>          contain the min(M,N)-by-N upper trapezoidal matrix R (R is
70*>          upper triangular if m >= n); the elements below the diagonal,
71*>          with the array TAU, represent the orthogonal matrix Q as a
72*>          product of min(m,n) elementary reflectors (see Further
73*>          Details).
74*> \endverbatim
75*>
76*> \param[in] LDA
77*> \verbatim
78*>          LDA is INTEGER
79*>          The leading dimension of the array A.  LDA >= max(1,M).
80*> \endverbatim
81*>
82*> \param[out] TAU
83*> \verbatim
84*>          TAU is DOUBLE PRECISION array, dimension (min(M,N))
85*>          The scalar factors of the elementary reflectors (see Further
86*>          Details).
87*> \endverbatim
88*>
89*> \param[out] WORK
90*> \verbatim
91*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
92*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
93*> \endverbatim
94*>
95*> \param[in] LWORK
96*> \verbatim
97*>          LWORK is INTEGER
98*>          The dimension of the array WORK.  LWORK >= max(1,N).
99*>          For optimum performance LWORK >= N*NB, where NB is
100*>          the optimal blocksize.
101*>
102*>          If LWORK = -1, then a workspace query is assumed; the routine
103*>          only calculates the optimal size of the WORK array, returns
104*>          this value as the first entry of the WORK array, and no error
105*>          message related to LWORK is issued by XERBLA.
106*> \endverbatim
107*>
108*> \param[out] INFO
109*> \verbatim
110*>          INFO is INTEGER
111*>          = 0:  successful exit
112*>          < 0:  if INFO = -i, the i-th argument had an illegal value
113*> \endverbatim
114*
115*  Authors:
116*  ========
117*
118*> \author Univ. of Tennessee
119*> \author Univ. of California Berkeley
120*> \author Univ. of Colorado Denver
121*> \author NAG Ltd.
122*
123*> \ingroup doubleGEcomputational
124*
125*> \par Further Details:
126*  =====================
127*>
128*> \verbatim
129*>
130*>  The matrix Q is represented as a product of elementary reflectors
131*>
132*>     Q = H(1) H(2) . . . H(k), where k = min(m,n).
133*>
134*>  Each H(i) has the form
135*>
136*>     H(i) = I - tau * v * v**T
137*>
138*>  where tau is a real scalar, and v is a real vector with
139*>  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
140*>  and tau in TAU(i).
141*> \endverbatim
142*>
143*  =====================================================================
144      SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
145*
146*  -- LAPACK computational routine --
147*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
148*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
149*
150*     .. Scalar Arguments ..
151      INTEGER            INFO, LDA, LWORK, M, N
152*     ..
153*     .. Array Arguments ..
154      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
155*     ..
156*
157*  =====================================================================
158*
159*     .. Local Scalars ..
160      LOGICAL            LQUERY
161      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
162     $                   NBMIN, NX
163*     ..
164*     .. External Subroutines ..
165      EXTERNAL           DGEQR2, DLARFB, DLARFT, XERBLA
166*     ..
167*     .. Intrinsic Functions ..
168      INTRINSIC          MAX, MIN
169*     ..
170*     .. External Functions ..
171      INTEGER            ILAENV
172      EXTERNAL           ILAENV
173*     ..
174*     .. Executable Statements ..
175*
176*     Test the input arguments
177*
178      INFO = 0
179      NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
180      LWKOPT = N*NB
181      WORK( 1 ) = LWKOPT
182      LQUERY = ( LWORK.EQ.-1 )
183      IF( M.LT.0 ) THEN
184         INFO = -1
185      ELSE IF( N.LT.0 ) THEN
186         INFO = -2
187      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
188         INFO = -4
189      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
190         INFO = -7
191      END IF
192      IF( INFO.NE.0 ) THEN
193         CALL XERBLA( 'DGEQRF', -INFO )
194         RETURN
195      ELSE IF( LQUERY ) THEN
196         RETURN
197      END IF
198*
199*     Quick return if possible
200*
201      K = MIN( M, N )
202      IF( K.EQ.0 ) THEN
203         WORK( 1 ) = 1
204         RETURN
205      END IF
206*
207      NBMIN = 2
208      NX = 0
209      IWS = N
210      IF( NB.GT.1 .AND. NB.LT.K ) THEN
211*
212*        Determine when to cross over from blocked to unblocked code.
213*
214         NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
215         IF( NX.LT.K ) THEN
216*
217*           Determine if workspace is large enough for blocked code.
218*
219            LDWORK = N
220            IWS = LDWORK*NB
221            IF( LWORK.LT.IWS ) THEN
222*
223*              Not enough workspace to use optimal NB:  reduce NB and
224*              determine the minimum value of NB.
225*
226               NB = LWORK / LDWORK
227               NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
228     $                 -1 ) )
229            END IF
230         END IF
231      END IF
232*
233      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
234*
235*        Use blocked code initially
236*
237         DO 10 I = 1, K - NX, NB
238            IB = MIN( K-I+1, NB )
239*
240*           Compute the QR factorization of the current block
241*           A(i:m,i:i+ib-1)
242*
243            CALL DGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
244     $                   IINFO )
245            IF( I+IB.LE.N ) THEN
246*
247*              Form the triangular factor of the block reflector
248*              H = H(i) H(i+1) . . . H(i+ib-1)
249*
250               CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
251     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
252*
253*              Apply H**T to A(i:m,i+ib:n) from the left
254*
255               CALL DLARFB( 'Left', 'Transpose', 'Forward',
256     $                      'Columnwise', M-I+1, N-I-IB+1, IB,
257     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
258     $                      LDA, WORK( IB+1 ), LDWORK )
259            END IF
260   10    CONTINUE
261      ELSE
262         I = 1
263      END IF
264*
265*     Use unblocked code to factor the last or only block.
266*
267      IF( I.LE.K )
268     $   CALL DGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
269     $                IINFO )
270*
271      WORK( 1 ) = IWS
272      RETURN
273*
274*     End of DGEQRF
275*
276      END
277