1*> \brief \b ZUNGLQ
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZUNGLQ + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunglq.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunglq.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunglq.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INFO, K, LDA, LWORK, M, N
25*       ..
26*       .. Array Arguments ..
27*       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
28*       ..
29*
30*
31*> \par Purpose:
32*  =============
33*>
34*> \verbatim
35*>
36*> ZUNGLQ generates an M-by-N complex matrix Q with orthonormal rows,
37*> which is defined as the first M rows of a product of K elementary
38*> reflectors of order N
39*>
40*>       Q  =  H(k)**H . . . H(2)**H H(1)**H
41*>
42*> as returned by ZGELQF.
43*> \endverbatim
44*
45*  Arguments:
46*  ==========
47*
48*> \param[in] M
49*> \verbatim
50*>          M is INTEGER
51*>          The number of rows of the matrix Q. M >= 0.
52*> \endverbatim
53*>
54*> \param[in] N
55*> \verbatim
56*>          N is INTEGER
57*>          The number of columns of the matrix Q. N >= M.
58*> \endverbatim
59*>
60*> \param[in] K
61*> \verbatim
62*>          K is INTEGER
63*>          The number of elementary reflectors whose product defines the
64*>          matrix Q. M >= K >= 0.
65*> \endverbatim
66*>
67*> \param[in,out] A
68*> \verbatim
69*>          A is COMPLEX*16 array, dimension (LDA,N)
70*>          On entry, the i-th row must contain the vector which defines
71*>          the elementary reflector H(i), for i = 1,2,...,k, as returned
72*>          by ZGELQF in the first k rows of its array argument A.
73*>          On exit, the M-by-N matrix Q.
74*> \endverbatim
75*>
76*> \param[in] LDA
77*> \verbatim
78*>          LDA is INTEGER
79*>          The first dimension of the array A. LDA >= max(1,M).
80*> \endverbatim
81*>
82*> \param[in] TAU
83*> \verbatim
84*>          TAU is COMPLEX*16 array, dimension (K)
85*>          TAU(i) must contain the scalar factor of the elementary
86*>          reflector H(i), as returned by ZGELQF.
87*> \endverbatim
88*>
89*> \param[out] WORK
90*> \verbatim
91*>          WORK is COMPLEX*16 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,M).
99*>          For optimum performance LWORK >= M*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 has 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 complex16OTHERcomputational
124*
125*  =====================================================================
126      SUBROUTINE ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
127*
128*  -- LAPACK computational routine --
129*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
130*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
131*
132*     .. Scalar Arguments ..
133      INTEGER            INFO, K, LDA, LWORK, M, N
134*     ..
135*     .. Array Arguments ..
136      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
137*     ..
138*
139*  =====================================================================
140*
141*     .. Parameters ..
142      COMPLEX*16         ZERO
143      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
144*     ..
145*     .. Local Scalars ..
146      LOGICAL            LQUERY
147      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
148     $                   LWKOPT, NB, NBMIN, NX
149*     ..
150*     .. External Subroutines ..
151      EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNGL2
152*     ..
153*     .. Intrinsic Functions ..
154      INTRINSIC          MAX, MIN
155*     ..
156*     .. External Functions ..
157      INTEGER            ILAENV
158      EXTERNAL           ILAENV
159*     ..
160*     .. Executable Statements ..
161*
162*     Test the input arguments
163*
164      INFO = 0
165      NB = ILAENV( 1, 'ZUNGLQ', ' ', M, N, K, -1 )
166      LWKOPT = MAX( 1, M )*NB
167      WORK( 1 ) = LWKOPT
168      LQUERY = ( LWORK.EQ.-1 )
169      IF( M.LT.0 ) THEN
170         INFO = -1
171      ELSE IF( N.LT.M ) THEN
172         INFO = -2
173      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
174         INFO = -3
175      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
176         INFO = -5
177      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
178         INFO = -8
179      END IF
180      IF( INFO.NE.0 ) THEN
181         CALL XERBLA( 'ZUNGLQ', -INFO )
182         RETURN
183      ELSE IF( LQUERY ) THEN
184         RETURN
185      END IF
186*
187*     Quick return if possible
188*
189      IF( M.LE.0 ) THEN
190         WORK( 1 ) = 1
191         RETURN
192      END IF
193*
194      NBMIN = 2
195      NX = 0
196      IWS = M
197      IF( NB.GT.1 .AND. NB.LT.K ) THEN
198*
199*        Determine when to cross over from blocked to unblocked code.
200*
201         NX = MAX( 0, ILAENV( 3, 'ZUNGLQ', ' ', M, N, K, -1 ) )
202         IF( NX.LT.K ) THEN
203*
204*           Determine if workspace is large enough for blocked code.
205*
206            LDWORK = M
207            IWS = LDWORK*NB
208            IF( LWORK.LT.IWS ) THEN
209*
210*              Not enough workspace to use optimal NB:  reduce NB and
211*              determine the minimum value of NB.
212*
213               NB = LWORK / LDWORK
214               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGLQ', ' ', M, N, K, -1 ) )
215            END IF
216         END IF
217      END IF
218*
219      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
220*
221*        Use blocked code after the last block.
222*        The first kk rows are handled by the block method.
223*
224         KI = ( ( K-NX-1 ) / NB )*NB
225         KK = MIN( K, KI+NB )
226*
227*        Set A(kk+1:m,1:kk) to zero.
228*
229         DO 20 J = 1, KK
230            DO 10 I = KK + 1, M
231               A( I, J ) = ZERO
232   10       CONTINUE
233   20    CONTINUE
234      ELSE
235         KK = 0
236      END IF
237*
238*     Use unblocked code for the last or only block.
239*
240      IF( KK.LT.M )
241     $   CALL ZUNGL2( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
242     $                TAU( KK+1 ), WORK, IINFO )
243*
244      IF( KK.GT.0 ) THEN
245*
246*        Use blocked code
247*
248         DO 50 I = KI + 1, 1, -NB
249            IB = MIN( NB, K-I+1 )
250            IF( I+IB.LE.M ) THEN
251*
252*              Form the triangular factor of the block reflector
253*              H = H(i) H(i+1) . . . H(i+ib-1)
254*
255               CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
256     $                      LDA, TAU( I ), WORK, LDWORK )
257*
258*              Apply H**H to A(i+ib:m,i:n) from the right
259*
260               CALL ZLARFB( 'Right', 'Conjugate transpose', 'Forward',
261     $                      'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
262     $                      LDA, WORK, LDWORK, A( I+IB, I ), LDA,
263     $                      WORK( IB+1 ), LDWORK )
264            END IF
265*
266*           Apply H**H to columns i:n of current block
267*
268            CALL ZUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
269     $                   IINFO )
270*
271*           Set columns 1:i-1 of current block to zero
272*
273            DO 40 J = 1, I - 1
274               DO 30 L = I, I + IB - 1
275                  A( L, J ) = ZERO
276   30          CONTINUE
277   40       CONTINUE
278   50    CONTINUE
279      END IF
280*
281      WORK( 1 ) = IWS
282      RETURN
283*
284*     End of ZUNGLQ
285*
286      END
287