1: *> \brief \b ZGEMLQ
2: *
3: * Definition:
4: * ===========
5: *
6: * SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
7: * $ TSIZE, C, LDC, WORK, LWORK, INFO )
8: *
9: *
10: * .. Scalar Arguments ..
11: * CHARACTER SIDE, TRANS
12: * INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
13: * ..
14: * .. Array Arguments ..
15: * COMPLEX*16 A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
16: *> \par Purpose:
17: * =============
18: *>
19: *> \verbatim
20: *>
21: *> ZGEMLQ overwrites the general real M-by-N matrix C with
22: *>
23: *> SIDE = 'L' SIDE = 'R'
24: *> TRANS = 'N': Q * C C * Q
25: *> TRANS = 'C': Q**H * C C * Q**H
26: *> where Q is a complex unitary matrix defined as the product
27: *> of blocked elementary reflectors computed by short wide
28: *> LQ factorization (ZGELQ)
29: *>
30: *> \endverbatim
31: *
32: * Arguments:
33: * ==========
34: *
35: *> \param[in] SIDE
36: *> \verbatim
37: *> SIDE is CHARACTER*1
38: *> = 'L': apply Q or Q**H from the Left;
39: *> = 'R': apply Q or Q**H from the Right.
40: *> \endverbatim
41: *>
42: *> \param[in] TRANS
43: *> \verbatim
44: *> TRANS is CHARACTER*1
45: *> = 'N': No transpose, apply Q;
46: *> = 'C': Conjugate transpose, apply Q**H.
47: *> \endverbatim
48: *>
49: *> \param[in] M
50: *> \verbatim
51: *> M is INTEGER
52: *> The number of rows of the matrix A. M >=0.
53: *> \endverbatim
54: *>
55: *> \param[in] N
56: *> \verbatim
57: *> N is INTEGER
58: *> The number of columns of the matrix C. N >= 0.
59: *> \endverbatim
60: *>
61: *> \param[in] K
62: *> \verbatim
63: *> K is INTEGER
64: *> The number of elementary reflectors whose product defines
65: *> the matrix Q.
66: *> If SIDE = 'L', M >= K >= 0;
67: *> if SIDE = 'R', N >= K >= 0.
68: *>
69: *> \endverbatim
70: *>
71: *> \param[in] A
72: *> \verbatim
73: *> A is COMPLEX*16 array, dimension
74: *> (LDA,M) if SIDE = 'L',
75: *> (LDA,N) if SIDE = 'R'
76: *> Part of the data structure to represent Q as returned by ZGELQ.
77: *> \endverbatim
78: *>
79: *> \param[in] LDA
80: *> \verbatim
81: *> LDA is INTEGER
82: *> The leading dimension of the array A. LDA >= max(1,K).
83: *> \endverbatim
84: *>
85: *> \param[in] T
86: *> \verbatim
87: *> T is COMPLEX*16 array, dimension (MAX(5,TSIZE)).
88: *> Part of the data structure to represent Q as returned by ZGELQ.
89: *> \endverbatim
90: *>
91: *> \param[in] TSIZE
92: *> \verbatim
93: *> TSIZE is INTEGER
94: *> The dimension of the array T. TSIZE >= 5.
95: *> \endverbatim
96: *>
97: *> \param[in,out] C
98: *> \verbatim
99: *> C is COMPLEX*16 array, dimension (LDC,N)
100: *> On entry, the M-by-N matrix C.
101: *> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
102: *> \endverbatim
103: *>
104: *> \param[in] LDC
105: *> \verbatim
106: *> LDC is INTEGER
107: *> The leading dimension of the array C. LDC >= max(1,M).
108: *> \endverbatim
109: *>
110: *> \param[out] WORK
111: *> \verbatim
112: *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
113: *> \endverbatim
114: *>
115: *> \param[in] LWORK
116: *> \verbatim
117: *> LWORK is INTEGER
118: *> The dimension of the array WORK.
119: *> If LWORK = -1, then a workspace query is assumed. The routine
120: *> only calculates the size of the WORK array, returns this
121: *> value as WORK(1), and no error message related to WORK
122: *> is issued by XERBLA.
123: *> \endverbatim
124: *>
125: *> \param[out] INFO
126: *> \verbatim
127: *> INFO is INTEGER
128: *> = 0: successful exit
129: *> < 0: if INFO = -i, the i-th argument had an illegal value
130: *> \endverbatim
131: *
132: * Authors:
133: * ========
134: *
135: *> \author Univ. of Tennessee
136: *> \author Univ. of California Berkeley
137: *> \author Univ. of Colorado Denver
138: *> \author NAG Ltd.
139: *
140: *> \par Further Details
141: * ====================
142: *>
143: *> \verbatim
144: *>
145: *> These details are particular for this LAPACK implementation. Users should not
146: *> take them for granted. These details may change in the future, and are not likely
147: *> true for another LAPACK implementation. These details are relevant if one wants
148: *> to try to understand the code. They are not part of the interface.
149: *>
150: *> In this version,
151: *>
152: *> T(2): row block size (MB)
153: *> T(3): column block size (NB)
154: *> T(6:TSIZE): data structure needed for Q, computed by
155: *> ZLASWLQ or ZGELQT
156: *>
157: *> Depending on the matrix dimensions M and N, and row and column
158: *> block sizes MB and NB returned by ILAENV, ZGELQ will use either
159: *> ZLASWLQ (if the matrix is wide-and-short) or ZGELQT to compute
160: *> the LQ factorization.
161: *> This version of ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to
162: *> multiply matrix Q by another matrix.
163: *> Further Details in ZLAMSWLQ or ZGEMLQT.
164: *> \endverbatim
165: *>
166: * =====================================================================
167: SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
168: $ C, LDC, WORK, LWORK, INFO )
169: *
170: * -- LAPACK computational routine --
171: * -- LAPACK is a software package provided by Univ. of Tennessee, --
172: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
173: *
174: * .. Scalar Arguments ..
175: CHARACTER SIDE, TRANS
176: INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
177: * ..
178: * .. Array Arguments ..
179: COMPLEX*16 A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
180: * ..
181: *
182: * =====================================================================
183: *
184: * ..
185: * .. Local Scalars ..
186: LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
187: INTEGER MB, NB, LW, NBLCKS, MN
188: * ..
189: * .. External Functions ..
190: LOGICAL LSAME
191: EXTERNAL LSAME
192: * ..
193: * .. External Subroutines ..
194: EXTERNAL ZLAMSWLQ, ZGEMLQT, XERBLA
195: * ..
196: * .. Intrinsic Functions ..
197: INTRINSIC INT, MAX, MIN, MOD
198: * ..
199: * .. Executable Statements ..
200: *
201: * Test the input arguments
202: *
203: LQUERY = LWORK.EQ.-1
204: NOTRAN = LSAME( TRANS, 'N' )
205: TRAN = LSAME( TRANS, 'C' )
206: LEFT = LSAME( SIDE, 'L' )
207: RIGHT = LSAME( SIDE, 'R' )
208: *
209: MB = INT( T( 2 ) )
210: NB = INT( T( 3 ) )
211: IF( LEFT ) THEN
212: LW = N * MB
213: MN = M
214: ELSE
215: LW = M * MB
216: MN = N
217: END IF
218: *
219: IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
220: IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
221: NBLCKS = ( MN - K ) / ( NB - K )
222: ELSE
223: NBLCKS = ( MN - K ) / ( NB - K ) + 1
224: END IF
225: ELSE
226: NBLCKS = 1
227: END IF
228: *
229: INFO = 0
230: IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
231: INFO = -1
232: ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
233: INFO = -2
234: ELSE IF( M.LT.0 ) THEN
235: INFO = -3
236: ELSE IF( N.LT.0 ) THEN
237: INFO = -4
238: ELSE IF( K.LT.0 .OR. K.GT.MN ) THEN
239: INFO = -5
240: ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
241: INFO = -7
242: ELSE IF( TSIZE.LT.5 ) THEN
243: INFO = -9
244: ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
245: INFO = -11
246: ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
247: INFO = -13
248: END IF
249: *
250: IF( INFO.EQ.0 ) THEN
251: WORK( 1 ) = LW
252: END IF
253: *
254: IF( INFO.NE.0 ) THEN
255: CALL XERBLA( 'ZGEMLQ', -INFO )
256: RETURN
257: ELSE IF( LQUERY ) THEN
258: RETURN
259: END IF
260: *
261: * Quick return if possible
262: *
263: IF( MIN( M, N, K ).EQ.0 ) THEN
264: RETURN
265: END IF
266: *
267: IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
268: $ .OR. ( NB.LE.K ) .OR. ( NB.GE.MAX( M, N, K ) ) ) THEN
269: CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
270: $ T( 6 ), MB, C, LDC, WORK, INFO )
271: ELSE
272: CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
273: $ MB, C, LDC, WORK, LWORK, INFO )
274: END IF
275: *
276: WORK( 1 ) = LW
277: *
278: RETURN
279: *
280: * End of ZGEMLQ
281: *
282: END
CVSweb interface <joel.bertrand@systella.fr>