LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cunmql()

subroutine cunmql ( character  side,
character  trans,
integer  m,
integer  n,
integer  k,
complex, dimension( lda, * )  a,
integer  lda,
complex, dimension( * )  tau,
complex, dimension( ldc, * )  c,
integer  ldc,
complex, dimension( * )  work,
integer  lwork,
integer  info 
)

CUNMQL

Download CUNMQL + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 CUNMQL overwrites the general complex M-by-N matrix C with

                 SIDE = 'L'     SIDE = 'R'
 TRANS = 'N':      Q * C          C * Q
 TRANS = 'C':      Q**H * C       C * Q**H

 where Q is a complex unitary matrix defined as the product of k
 elementary reflectors

       Q = H(k) . . . H(2) H(1)

 as returned by CGEQLF. Q is of order M if SIDE = 'L' and of order N
 if SIDE = 'R'.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
          = 'L': apply Q or Q**H from the Left;
          = 'R': apply Q or Q**H from the Right.
[in]TRANS
          TRANS is CHARACTER*1
          = 'N':  No transpose, apply Q;
          = 'C':  Conjugate transpose, apply Q**H.
[in]M
          M is INTEGER
          The number of rows of the matrix C. M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix C. N >= 0.
[in]K
          K is INTEGER
          The number of elementary reflectors whose product defines
          the matrix Q.
          If SIDE = 'L', M >= K >= 0;
          if SIDE = 'R', N >= K >= 0.
[in]A
          A is COMPLEX array, dimension (LDA,K)
          The i-th column must contain the vector which defines the
          elementary reflector H(i), for i = 1,2,...,k, as returned by
          CGEQLF in the last k columns of its array argument A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.
          If SIDE = 'L', LDA >= max(1,M);
          if SIDE = 'R', LDA >= max(1,N).
[in]TAU
          TAU is COMPLEX array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by CGEQLF.
[in,out]C
          C is COMPLEX array, dimension (LDC,N)
          On entry, the M-by-N matrix C.
          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C. LDC >= max(1,M).
[out]WORK
          WORK is COMPLEX array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.
          If SIDE = 'L', LWORK >= max(1,N);
          if SIDE = 'R', LWORK >= max(1,M).
          For good performance, LWORK should generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 166 of file cunmql.f.

168*
169* -- LAPACK computational routine --
170* -- LAPACK is a software package provided by Univ. of Tennessee, --
171* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172*
173* .. Scalar Arguments ..
174 CHARACTER SIDE, TRANS
175 INTEGER INFO, K, LDA, LDC, LWORK, M, N
176* ..
177* .. Array Arguments ..
178 COMPLEX A( LDA, * ), C( LDC, * ), TAU( * ),
179 $ WORK( * )
180* ..
181*
182* =====================================================================
183*
184* .. Parameters ..
185 INTEGER NBMAX, LDT, TSIZE
186 parameter( nbmax = 64, ldt = nbmax+1,
187 $ tsize = ldt*nbmax )
188* ..
189* .. Local Scalars ..
190 LOGICAL LEFT, LQUERY, NOTRAN
191 INTEGER I, I1, I2, I3, IB, IINFO, IWT, LDWORK, LWKOPT,
192 $ MI, NB, NBMIN, NI, NQ, NW
193* ..
194* .. External Functions ..
195 LOGICAL LSAME
196 INTEGER ILAENV
197 REAL SROUNDUP_LWORK
198 EXTERNAL lsame, ilaenv, sroundup_lwork
199* ..
200* .. External Subroutines ..
201 EXTERNAL clarfb, clarft, cunm2l, xerbla
202* ..
203* .. Intrinsic Functions ..
204 INTRINSIC max, min
205* ..
206* .. Executable Statements ..
207*
208* Test the input arguments
209*
210 info = 0
211 left = lsame( side, 'L' )
212 notran = lsame( trans, 'N' )
213 lquery = ( lwork.EQ.-1 )
214*
215* NQ is the order of Q and NW is the minimum dimension of WORK
216*
217 IF( left ) THEN
218 nq = m
219 nw = max( 1, n )
220 ELSE
221 nq = n
222 nw = max( 1, m )
223 END IF
224 IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
225 info = -1
226 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'C' ) ) THEN
227 info = -2
228 ELSE IF( m.LT.0 ) THEN
229 info = -3
230 ELSE IF( n.LT.0 ) THEN
231 info = -4
232 ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
233 info = -5
234 ELSE IF( lda.LT.max( 1, nq ) ) THEN
235 info = -7
236 ELSE IF( ldc.LT.max( 1, m ) ) THEN
237 info = -10
238 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
239 info = -12
240 END IF
241*
242 IF( info.EQ.0 ) THEN
243*
244* Compute the workspace requirements
245*
246 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
247 lwkopt = 1
248 ELSE
249 nb = min( nbmax, ilaenv( 1, 'CUNMQL', side // trans, m, n,
250 $ k, -1 ) )
251 lwkopt = nw*nb + tsize
252 END IF
253 work( 1 ) = sroundup_lwork(lwkopt)
254 END IF
255*
256 IF( info.NE.0 ) THEN
257 CALL xerbla( 'CUNMQL', -info )
258 RETURN
259 ELSE IF( lquery ) THEN
260 RETURN
261 END IF
262*
263* Quick return if possible
264*
265 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
266 RETURN
267 END IF
268*
269* Determine the block size
270*
271 nbmin = 2
272 ldwork = nw
273 IF( nb.GT.1 .AND. nb.LT.k ) THEN
274 IF( lwork.LT.lwkopt ) THEN
275 nb = (lwork-tsize) / ldwork
276 nbmin = max( 2, ilaenv( 2, 'CUNMQL', side // trans, m, n, k,
277 $ -1 ) )
278 END IF
279 END IF
280*
281 IF( nb.LT.nbmin .OR. nb.GE.k ) THEN
282*
283* Use unblocked code
284*
285 CALL cunm2l( side, trans, m, n, k, a, lda, tau, c, ldc, work,
286 $ iinfo )
287 ELSE
288*
289* Use blocked code
290*
291 iwt = 1 + nw*nb
292 IF( ( left .AND. notran ) .OR.
293 $ ( .NOT.left .AND. .NOT.notran ) ) THEN
294 i1 = 1
295 i2 = k
296 i3 = nb
297 ELSE
298 i1 = ( ( k-1 ) / nb )*nb + 1
299 i2 = 1
300 i3 = -nb
301 END IF
302*
303 IF( left ) THEN
304 ni = n
305 ELSE
306 mi = m
307 END IF
308*
309 DO 10 i = i1, i2, i3
310 ib = min( nb, k-i+1 )
311*
312* Form the triangular factor of the block reflector
313* H = H(i+ib-1) . . . H(i+1) H(i)
314*
315 CALL clarft( 'Backward', 'Columnwise', nq-k+i+ib-1, ib,
316 $ a( 1, i ), lda, tau( i ), work( iwt ), ldt )
317 IF( left ) THEN
318*
319* H or H**H is applied to C(1:m-k+i+ib-1,1:n)
320*
321 mi = m - k + i + ib - 1
322 ELSE
323*
324* H or H**H is applied to C(1:m,1:n-k+i+ib-1)
325*
326 ni = n - k + i + ib - 1
327 END IF
328*
329* Apply H or H**H
330*
331 CALL clarfb( side, trans, 'Backward', 'Columnwise', mi, ni,
332 $ ib, a( 1, i ), lda, work( iwt ), ldt, c, ldc,
333 $ work, ldwork )
334 10 CONTINUE
335 END IF
336 work( 1 ) = sroundup_lwork(lwkopt)
337 RETURN
338*
339* End of CUNMQL
340*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
clarfb
subroutine clarfb(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
CLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix.
Definition clarfb.f:197
clarft
subroutine clarft(direct, storev, n, k, v, ldv, tau, t, ldt)
CLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition clarft.f:163
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
sroundup_lwork
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
Definition sroundup_lwork.f:59
cunm2l
subroutine cunm2l(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
CUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf...
Definition cunm2l.f:159
Here is the call graph for this function:
Here is the caller graph for this function: