1: *
2: * Definition:
3: * ===========
4: *
5: * SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
6: * $ TSIZE, C, LDC, WORK, LWORK, INFO )
7: *
8: *
9: * .. Scalar Arguments ..
10: * CHARACTER SIDE, TRANS
11: * INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
12: * ..
13: * .. Array Arguments ..
14: * COMPLEX*16 A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
15: *> \par Purpose:
16: * =============
17: *>
18: *> \verbatim
19: *>
20: *> ZGEMLQ overwrites the general real M-by-N matrix C with
21: *>
22: *> SIDE = 'L' SIDE = 'R'
23: *> TRANS = 'N': Q * C C * Q
24: *> TRANS = 'C': Q**H * C C * Q**H
25: *> where Q is a complex unitary matrix defined as the product
26: *> of blocked elementary reflectors computed by short wide
27: *> LQ factorization (ZGELQ)
28: *>
29: *> \endverbatim
30: *
31: * Arguments:
32: * ==========
33: *
34: *> \param[in] SIDE
35: *> \verbatim
36: *> SIDE is CHARACTER*1
37: *> = 'L': apply Q or Q**T from the Left;
38: *> = 'R': apply Q or Q**T from the Right.
39: *> \endverbatim
40: *>
41: *> \param[in] TRANS
42: *> \verbatim
43: *> TRANS is CHARACTER*1
44: *> = 'N': No transpose, apply Q;
45: *> = 'T': Transpose, apply Q**T.
46: *> \endverbatim
47: *>
48: *> \param[in] M
49: *> \verbatim
50: *> M is INTEGER
51: *> The number of rows of the matrix A. M >=0.
52: *> \endverbatim
53: *>
54: *> \param[in] N
55: *> \verbatim
56: *> N is INTEGER
57: *> The number of columns of the matrix C. N >= 0.
58: *> \endverbatim
59: *>
60: *> \param[in] K
61: *> \verbatim
62: *> K is INTEGER
63: *> The number of elementary reflectors whose product defines
64: *> the matrix Q.
65: *> If SIDE = 'L', M >= K >= 0;
66: *> if SIDE = 'R', N >= K >= 0.
67: *>
68: *> \endverbatim
69: *>
70: *> \param[in] A
71: *> \verbatim
72: *> A is COMPLEX*16 array, dimension
73: *> (LDA,M) if SIDE = 'L',
74: *> (LDA,N) if SIDE = 'R'
75: *> Part of the data structure to represent Q as returned by ZGELQ.
76: *> \endverbatim
77: *>
78: *> \param[in] LDA
79: *> \verbatim
80: *> LDA is INTEGER
81: *> The leading dimension of the array A. LDA >= max(1,K).
82: *> \endverbatim
83: *>
84: *> \param[in] T
85: *> \verbatim
86: *> T is COMPLEX*16 array, dimension (MAX(5,TSIZE)).
87: *> Part of the data structure to represent Q as returned by ZGELQ.
88: *> \endverbatim
89: *>
90: *> \param[in] TSIZE
91: *> \verbatim
92: *> TSIZE is INTEGER
93: *> The dimension of the array T. TSIZE >= 5.
94: *> \endverbatim
95: *>
96: *> \param[in,out] C
97: *> \verbatim
98: *> C is COMPLEX*16 array, dimension (LDC,N)
99: *> On entry, the M-by-N matrix C.
100: *> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
101: *> \endverbatim
102: *>
103: *> \param[in] LDC
104: *> \verbatim
105: *> LDC is INTEGER
106: *> The leading dimension of the array C. LDC >= max(1,M).
107: *> \endverbatim
108: *>
109: *> \param[out] WORK
110: *> \verbatim
111: *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
112: *> \endverbatim
113: *>
114: *> \param[in] LWORK
115: *> \verbatim
116: *> LWORK is INTEGER
117: *> The dimension of the array WORK.
118: *> If LWORK = -1, then a workspace query is assumed. The routine
119: *> only calculates the size of the WORK array, returns this
120: *> value as WORK(1), and no error message related to WORK
121: *> is issued by XERBLA.
122: *> \endverbatim
123: *>
124: *> \param[out] INFO
125: *> \verbatim
126: *> INFO is INTEGER
127: *> = 0: successful exit
128: *> < 0: if INFO = -i, the i-th argument had an illegal value
129: *> \endverbatim
130: *
131: * Authors:
132: * ========
133: *
134: *> \author Univ. of Tennessee
135: *> \author Univ. of California Berkeley
136: *> \author Univ. of Colorado Denver
137: *> \author NAG Ltd.
138: *
139: *> \par Further Details
140: * ====================
141: *>
142: *> \verbatim
143: *>
144: *> These details are particular for this LAPACK implementation. Users should not
145: *> take them for granted. These details may change in the future, and are unlikely not
146: *> true for another LAPACK implementation. These details are relevant if one wants
147: *> to try to understand the code. They are not part of the interface.
148: *>
149: *> In this version,
150: *>
151: *> T(2): row block size (MB)
152: *> T(3): column block size (NB)
153: *> T(6:TSIZE): data structure needed for Q, computed by
154: *> ZLASWLQ or ZGELQT
155: *>
156: *> Depending on the matrix dimensions M and N, and row and column
157: *> block sizes MB and NB returned by ILAENV, ZGELQ will use either
158: *> ZLASWLQ (if the matrix is wide-and-short) or ZGELQT to compute
159: *> the LQ factorization.
160: *> This version of ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to
161: *> multiply matrix Q by another matrix.
162: *> Further Details in ZLAMSWLQ or ZGEMLQT.
163: *> \endverbatim
164: *>
165: * =====================================================================
166: SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
167: $ C, LDC, WORK, LWORK, INFO )
168: *
169: * -- LAPACK computational routine (version 3.7.0) --
170: * -- LAPACK is a software package provided by Univ. of Tennessee, --
171: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172: * December 2016
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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zgemlq.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack