1*> \brief \b SGEQR
2*
3*  Definition:
4*  ===========
5*
6*       SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
7*                         INFO )
8*
9*       .. Scalar Arguments ..
10*       INTEGER           INFO, LDA, M, N, TSIZE, LWORK
11*       ..
12*       .. Array Arguments ..
13*       REAL              A( LDA, * ), T( * ), WORK( * )
14*       ..
15*
16*
17*> \par Purpose:
18*  =============
19*>
20*> \verbatim
21*>
22*> SGEQR computes a QR factorization of a real M-by-N matrix A:
23*>
24*>    A = Q * ( R ),
25*>            ( 0 )
26*>
27*> where:
28*>
29*>    Q is a M-by-M orthogonal matrix;
30*>    R is an upper-triangular N-by-N matrix;
31*>    0 is a (M-N)-by-N zero matrix, if M > N.
32*>
33*> \endverbatim
34*
35*  Arguments:
36*  ==========
37*
38*> \param[in] M
39*> \verbatim
40*>          M is INTEGER
41*>          The number of rows of the matrix A.  M >= 0.
42*> \endverbatim
43*>
44*> \param[in] N
45*> \verbatim
46*>          N is INTEGER
47*>          The number of columns of the matrix A.  N >= 0.
48*> \endverbatim
49*>
50*> \param[in,out] A
51*> \verbatim
52*>          A is REAL array, dimension (LDA,N)
53*>          On entry, the M-by-N matrix A.
54*>          On exit, the elements on and above the diagonal of the array
55*>          contain the min(M,N)-by-N upper trapezoidal matrix R
56*>          (R is upper triangular if M >= N);
57*>          the elements below the diagonal are used to store part of the
58*>          data structure to represent Q.
59*> \endverbatim
60*>
61*> \param[in] LDA
62*> \verbatim
63*>          LDA is INTEGER
64*>          The leading dimension of the array A.  LDA >= max(1,M).
65*> \endverbatim
66*>
67*> \param[out] T
68*> \verbatim
69*>          T is REAL array, dimension (MAX(5,TSIZE))
70*>          On exit, if INFO = 0, T(1) returns optimal (or either minimal
71*>          or optimal, if query is assumed) TSIZE. See TSIZE for details.
72*>          Remaining T contains part of the data structure used to represent Q.
73*>          If one wants to apply or construct Q, then one needs to keep T
74*>          (in addition to A) and pass it to further subroutines.
75*> \endverbatim
76*>
77*> \param[in] TSIZE
78*> \verbatim
79*>          TSIZE is INTEGER
80*>          If TSIZE >= 5, the dimension of the array T.
81*>          If TSIZE = -1 or -2, then a workspace query is assumed. The routine
82*>          only calculates the sizes of the T and WORK arrays, returns these
83*>          values as the first entries of the T and WORK arrays, and no error
84*>          message related to T or WORK is issued by XERBLA.
85*>          If TSIZE = -1, the routine calculates optimal size of T for the
86*>          optimum performance and returns this value in T(1).
87*>          If TSIZE = -2, the routine calculates minimal size of T and
88*>          returns this value in T(1).
89*> \endverbatim
90*>
91*> \param[out] WORK
92*> \verbatim
93*>          (workspace) REAL array, dimension (MAX(1,LWORK))
94*>          On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
95*>          or optimal, if query was assumed) LWORK.
96*>          See LWORK for details.
97*> \endverbatim
98*>
99*> \param[in] LWORK
100*> \verbatim
101*>          LWORK is INTEGER
102*>          The dimension of the array WORK.
103*>          If LWORK = -1 or -2, then a workspace query is assumed. The routine
104*>          only calculates the sizes of the T and WORK arrays, returns these
105*>          values as the first entries of the T and WORK arrays, and no error
106*>          message related to T or WORK is issued by XERBLA.
107*>          If LWORK = -1, the routine calculates optimal size of WORK for the
108*>          optimal performance and returns this value in WORK(1).
109*>          If LWORK = -2, the routine calculates minimal size of WORK and
110*>          returns this value in WORK(1).
111*> \endverbatim
112*>
113*> \param[out] INFO
114*> \verbatim
115*>          INFO is INTEGER
116*>          = 0:  successful exit
117*>          < 0:  if INFO = -i, the i-th argument had an illegal value
118*> \endverbatim
119*
120*  Authors:
121*  ========
122*
123*> \author Univ. of Tennessee
124*> \author Univ. of California Berkeley
125*> \author Univ. of Colorado Denver
126*> \author NAG Ltd.
127*
128*> \par Further Details
129*  ====================
130*>
131*> \verbatim
132*>
133*> The goal of the interface is to give maximum freedom to the developers for
134*> creating any QR factorization algorithm they wish. The triangular
135*> (trapezoidal) R has to be stored in the upper part of A. The lower part of A
136*> and the array T can be used to store any relevant information for applying or
137*> constructing the Q factor. The WORK array can safely be discarded after exit.
138*>
139*> Caution: One should not expect the sizes of T and WORK to be the same from one
140*> LAPACK implementation to the other, or even from one execution to the other.
141*> A workspace query (for T and WORK) is needed at each execution. However,
142*> for a given execution, the size of T and WORK are fixed and will not change
143*> from one query to the next.
144*>
145*> \endverbatim
146*>
147*> \par Further Details particular to this LAPACK implementation:
148*  ==============================================================
149*>
150*> \verbatim
151*>
152*> These details are particular for this LAPACK implementation. Users should not
153*> take them for granted. These details may change in the future, and are not likely
154*> true for another LAPACK implementation. These details are relevant if one wants
155*> to try to understand the code. They are not part of the interface.
156*>
157*> In this version,
158*>
159*>          T(2): row block size (MB)
160*>          T(3): column block size (NB)
161*>          T(6:TSIZE): data structure needed for Q, computed by
162*>                           SLATSQR or SGEQRT
163*>
164*>  Depending on the matrix dimensions M and N, and row and column
165*>  block sizes MB and NB returned by ILAENV, SGEQR will use either
166*>  SLATSQR (if the matrix is tall-and-skinny) or SGEQRT to compute
167*>  the QR factorization.
168*>
169*> \endverbatim
170*>
171*  =====================================================================
172      SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
173     $                  INFO )
174*
175*  -- LAPACK computational routine (version 3.9.0) --
176*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
177*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
178*     November 2019
179*
180*     .. Scalar Arguments ..
181      INTEGER            INFO, LDA, M, N, TSIZE, LWORK
182*     ..
183*     .. Array Arguments ..
184      REAL               A( LDA, * ), T( * ), WORK( * )
185*     ..
186*
187*  =====================================================================
188*
189*     ..
190*     .. Local Scalars ..
191      LOGICAL            LQUERY, LMINWS, MINT, MINW
192      INTEGER            MB, NB, MINTSZ, NBLCKS
193*     ..
194*     .. External Functions ..
195      LOGICAL            LSAME
196      EXTERNAL           LSAME
197*     ..
198*     .. External Subroutines ..
199      EXTERNAL           SLATSQR, SGEQRT, XERBLA
200*     ..
201*     .. Intrinsic Functions ..
202      INTRINSIC          MAX, MIN, MOD
203*     ..
204*     .. External Functions ..
205      INTEGER            ILAENV
206      EXTERNAL           ILAENV
207*     ..
208*     .. Executable statements ..
209*
210*     Test the input arguments
211*
212      INFO = 0
213*
214      LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
215     $           LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
216*
217      MINT = .FALSE.
218      MINW = .FALSE.
219      IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
220        IF( TSIZE.NE.-1 ) MINT = .TRUE.
221        IF( LWORK.NE.-1 ) MINW = .TRUE.
222      END IF
223*
224*     Determine the block size
225*
226      IF( MIN( M, N ).GT.0 ) THEN
227        MB = ILAENV( 1, 'SGEQR ', ' ', M, N, 1, -1 )
228        NB = ILAENV( 1, 'SGEQR ', ' ', M, N, 2, -1 )
229      ELSE
230        MB = M
231        NB = 1
232      END IF
233      IF( MB.GT.M .OR. MB.LE.N ) MB = M
234      IF( NB.GT.MIN( M, N ) .OR. NB.LT.1 ) NB = 1
235      MINTSZ = N + 5
236      IF ( MB.GT.N .AND. M.GT.N ) THEN
237        IF( MOD( M - N, MB - N ).EQ.0 ) THEN
238          NBLCKS = ( M - N ) / ( MB - N )
239        ELSE
240          NBLCKS = ( M - N ) / ( MB - N ) + 1
241        END IF
242      ELSE
243        NBLCKS = 1
244      END IF
245*
246*     Determine if the workspace size satisfies minimal size
247*
248      LMINWS = .FALSE.
249      IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N )
250     $    .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ )
251     $    .AND. ( .NOT.LQUERY ) ) THEN
252        IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN
253          LMINWS = .TRUE.
254          NB = 1
255          MB = M
256        END IF
257        IF( LWORK.LT.NB*N ) THEN
258          LMINWS = .TRUE.
259          NB = 1
260        END IF
261      END IF
262*
263      IF( M.LT.0 ) THEN
264        INFO = -1
265      ELSE IF( N.LT.0 ) THEN
266        INFO = -2
267      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
268        INFO = -4
269      ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
270     $   .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
271        INFO = -6
272      ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY )
273     $   .AND. ( .NOT.LMINWS ) ) THEN
274        INFO = -8
275      END IF
276*
277      IF( INFO.EQ.0 ) THEN
278        IF( MINT ) THEN
279          T( 1 ) = MINTSZ
280        ELSE
281          T( 1 ) = NB*N*NBLCKS + 5
282        END IF
283        T( 2 ) = MB
284        T( 3 ) = NB
285        IF( MINW ) THEN
286          WORK( 1 ) = MAX( 1, N )
287        ELSE
288          WORK( 1 ) = MAX( 1, NB*N )
289        END IF
290      END IF
291      IF( INFO.NE.0 ) THEN
292        CALL XERBLA( 'SGEQR', -INFO )
293        RETURN
294      ELSE IF( LQUERY ) THEN
295        RETURN
296      END IF
297*
298*     Quick return if possible
299*
300      IF( MIN( M, N ).EQ.0 ) THEN
301        RETURN
302      END IF
303*
304*     The QR Decomposition
305*
306      IF( ( M.LE.N ) .OR. ( MB.LE.N ) .OR. ( MB.GE.M ) ) THEN
307        CALL SGEQRT( M, N, NB, A, LDA, T( 6 ), NB, WORK, INFO )
308      ELSE
309        CALL SLATSQR( M, N, MB, NB, A, LDA, T( 6 ), NB, WORK,
310     $                LWORK, INFO )
311      END IF
312*
313      WORK( 1 ) = MAX( 1, NB*N )
314*
315      RETURN
316*
317*     End of SGEQR
318*
319      END
320