1: *> \brief \b ZTPMLQT
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZTPMLQT + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztpmlqt.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztpmlqt.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztpmlqt.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
22: * A, LDA, B, LDB, WORK, INFO )
23: *
24: * .. Scalar Arguments ..
25: * CHARACTER SIDE, TRANS
26: * INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
27: * ..
28: * .. Array Arguments ..
29: * COMPLEX*16 V( LDV, * ), A( LDA, * ), B( LDB, * ),
30: * $ T( LDT, * ), WORK( * )
31: * ..
32: *
33: *
34: *> \par Purpose:
35: * =============
36: *>
37: *> \verbatim
38: *>
39: *> ZTPMLQT applies a complex unitary matrix Q obtained from a
40: *> "triangular-pentagonal" complex block reflector H to a general
41: *> complex matrix C, which consists of two blocks A and B.
42: *> \endverbatim
43: *
44: * Arguments:
45: * ==========
46: *
47: *> \param[in] SIDE
48: *> \verbatim
49: *> SIDE is CHARACTER*1
50: *> = 'L': apply Q or Q**H from the Left;
51: *> = 'R': apply Q or Q**H from the Right.
52: *> \endverbatim
53: *>
54: *> \param[in] TRANS
55: *> \verbatim
56: *> TRANS is CHARACTER*1
57: *> = 'N': No transpose, apply Q;
58: *> = 'C': Conjugate transpose, apply Q**H.
59: *> \endverbatim
60: *>
61: *> \param[in] M
62: *> \verbatim
63: *> M is INTEGER
64: *> The number of rows of the matrix B. M >= 0.
65: *> \endverbatim
66: *>
67: *> \param[in] N
68: *> \verbatim
69: *> N is INTEGER
70: *> The number of columns of the matrix B. N >= 0.
71: *> \endverbatim
72: *>
73: *> \param[in] K
74: *> \verbatim
75: *> K is INTEGER
76: *> The number of elementary reflectors whose product defines
77: *> the matrix Q.
78: *> \endverbatim
79: *>
80: *> \param[in] L
81: *> \verbatim
82: *> L is INTEGER
83: *> The order of the trapezoidal part of V.
84: *> K >= L >= 0. See Further Details.
85: *> \endverbatim
86: *>
87: *> \param[in] MB
88: *> \verbatim
89: *> MB is INTEGER
90: *> The block size used for the storage of T. K >= MB >= 1.
91: *> This must be the same value of MB used to generate T
92: *> in ZTPLQT.
93: *> \endverbatim
94: *>
95: *> \param[in] V
96: *> \verbatim
97: *> V is COMPLEX*16 array, dimension (LDV,K)
98: *> The i-th row must contain the vector which defines the
99: *> elementary reflector H(i), for i = 1,2,...,k, as returned by
100: *> ZTPLQT in B. See Further Details.
101: *> \endverbatim
102: *>
103: *> \param[in] LDV
104: *> \verbatim
105: *> LDV is INTEGER
106: *> The leading dimension of the array V. LDV >= K.
107: *> \endverbatim
108: *>
109: *> \param[in] T
110: *> \verbatim
111: *> T is COMPLEX*16 array, dimension (LDT,K)
112: *> The upper triangular factors of the block reflectors
113: *> as returned by ZTPLQT, stored as a MB-by-K matrix.
114: *> \endverbatim
115: *>
116: *> \param[in] LDT
117: *> \verbatim
118: *> LDT is INTEGER
119: *> The leading dimension of the array T. LDT >= MB.
120: *> \endverbatim
121: *>
122: *> \param[in,out] A
123: *> \verbatim
124: *> A is COMPLEX*16 array, dimension
125: *> (LDA,N) if SIDE = 'L' or
126: *> (LDA,K) if SIDE = 'R'
127: *> On entry, the K-by-N or M-by-K matrix A.
128: *> On exit, A is overwritten by the corresponding block of
129: *> Q*C or Q**H*C or C*Q or C*Q**H. See Further Details.
130: *> \endverbatim
131: *>
132: *> \param[in] LDA
133: *> \verbatim
134: *> LDA is INTEGER
135: *> The leading dimension of the array A.
136: *> If SIDE = 'L', LDA >= max(1,K);
137: *> If SIDE = 'R', LDA >= max(1,M).
138: *> \endverbatim
139: *>
140: *> \param[in,out] B
141: *> \verbatim
142: *> B is COMPLEX*16 array, dimension (LDB,N)
143: *> On entry, the M-by-N matrix B.
144: *> On exit, B is overwritten by the corresponding block of
145: *> Q*C or Q**H*C or C*Q or C*Q**H. See Further Details.
146: *> \endverbatim
147: *>
148: *> \param[in] LDB
149: *> \verbatim
150: *> LDB is INTEGER
151: *> The leading dimension of the array B.
152: *> LDB >= max(1,M).
153: *> \endverbatim
154: *>
155: *> \param[out] WORK
156: *> \verbatim
157: *> WORK is COMPLEX*16 array. The dimension of WORK is
158: *> N*MB if SIDE = 'L', or M*MB if SIDE = 'R'.
159: *> \endverbatim
160: *>
161: *> \param[out] INFO
162: *> \verbatim
163: *> INFO is INTEGER
164: *> = 0: successful exit
165: *> < 0: if INFO = -i, the i-th argument had an illegal value
166: *> \endverbatim
167: *
168: * Authors:
169: * ========
170: *
171: *> \author Univ. of Tennessee
172: *> \author Univ. of California Berkeley
173: *> \author Univ. of Colorado Denver
174: *> \author NAG Ltd.
175: *
176: *> \ingroup doubleOTHERcomputational
177: *
178: *> \par Further Details:
179: * =====================
180: *>
181: *> \verbatim
182: *>
183: *> The columns of the pentagonal matrix V contain the elementary reflectors
184: *> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a
185: *> trapezoidal block V2:
186: *>
187: *> V = [V1] [V2].
188: *>
189: *>
190: *> The size of the trapezoidal block V2 is determined by the parameter L,
191: *> where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L
192: *> rows of a K-by-K upper triangular matrix. If L=K, V2 is lower triangular;
193: *> if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
194: *>
195: *> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M.
196: *> [B]
197: *>
198: *> If SIDE = 'R': C = [A B] where A is M-by-K, B is M-by-N and V is K-by-N.
199: *>
200: *> The complex unitary matrix Q is formed from V and T.
201: *>
202: *> If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
203: *>
204: *> If TRANS='C' and SIDE='L', C is on exit replaced with Q**H * C.
205: *>
206: *> If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
207: *>
208: *> If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**H.
209: *> \endverbatim
210: *>
211: * =====================================================================
212: SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
213: $ A, LDA, B, LDB, WORK, INFO )
214: *
215: * -- LAPACK computational routine --
216: * -- LAPACK is a software package provided by Univ. of Tennessee, --
217: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
218: *
219: * .. Scalar Arguments ..
220: CHARACTER SIDE, TRANS
221: INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
222: * ..
223: * .. Array Arguments ..
224: COMPLEX*16 V( LDV, * ), A( LDA, * ), B( LDB, * ),
225: $ T( LDT, * ), WORK( * )
226: * ..
227: *
228: * =====================================================================
229: *
230: * ..
231: * .. Local Scalars ..
232: LOGICAL LEFT, RIGHT, TRAN, NOTRAN
233: INTEGER I, IB, NB, LB, KF, LDAQ
234: * ..
235: * .. External Functions ..
236: LOGICAL LSAME
237: EXTERNAL LSAME
238: * ..
239: * .. External Subroutines ..
240: EXTERNAL XERBLA, ZTPRFB
241: * ..
242: * .. Intrinsic Functions ..
243: INTRINSIC MAX, MIN
244: * ..
245: * .. Executable Statements ..
246: *
247: * .. Test the input arguments ..
248: *
249: INFO = 0
250: LEFT = LSAME( SIDE, 'L' )
251: RIGHT = LSAME( SIDE, 'R' )
252: TRAN = LSAME( TRANS, 'C' )
253: NOTRAN = LSAME( TRANS, 'N' )
254: *
255: IF ( LEFT ) THEN
256: LDAQ = MAX( 1, K )
257: ELSE IF ( RIGHT ) THEN
258: LDAQ = MAX( 1, M )
259: END IF
260: IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
261: INFO = -1
262: ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
263: INFO = -2
264: ELSE IF( M.LT.0 ) THEN
265: INFO = -3
266: ELSE IF( N.LT.0 ) THEN
267: INFO = -4
268: ELSE IF( K.LT.0 ) THEN
269: INFO = -5
270: ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
271: INFO = -6
272: ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN
273: INFO = -7
274: ELSE IF( LDV.LT.K ) THEN
275: INFO = -9
276: ELSE IF( LDT.LT.MB ) THEN
277: INFO = -11
278: ELSE IF( LDA.LT.LDAQ ) THEN
279: INFO = -13
280: ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
281: INFO = -15
282: END IF
283: *
284: IF( INFO.NE.0 ) THEN
285: CALL XERBLA( 'ZTPMLQT', -INFO )
286: RETURN
287: END IF
288: *
289: * .. Quick return if possible ..
290: *
291: IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
292: *
293: IF( LEFT .AND. NOTRAN ) THEN
294: *
295: DO I = 1, K, MB
296: IB = MIN( MB, K-I+1 )
297: NB = MIN( M-L+I+IB-1, M )
298: IF( I.GE.L ) THEN
299: LB = 0
300: ELSE
301: LB = 0
302: END IF
303: CALL ZTPRFB( 'L', 'C', 'F', 'R', NB, N, IB, LB,
304: $ V( I, 1 ), LDV, T( 1, I ), LDT,
305: $ A( I, 1 ), LDA, B, LDB, WORK, IB )
306: END DO
307: *
308: ELSE IF( RIGHT .AND. TRAN ) THEN
309: *
310: DO I = 1, K, MB
311: IB = MIN( MB, K-I+1 )
312: NB = MIN( N-L+I+IB-1, N )
313: IF( I.GE.L ) THEN
314: LB = 0
315: ELSE
316: LB = NB-N+L-I+1
317: END IF
318: CALL ZTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB,
319: $ V( I, 1 ), LDV, T( 1, I ), LDT,
320: $ A( 1, I ), LDA, B, LDB, WORK, M )
321: END DO
322: *
323: ELSE IF( LEFT .AND. TRAN ) THEN
324: *
325: KF = ((K-1)/MB)*MB+1
326: DO I = KF, 1, -MB
327: IB = MIN( MB, K-I+1 )
328: NB = MIN( M-L+I+IB-1, M )
329: IF( I.GE.L ) THEN
330: LB = 0
331: ELSE
332: LB = 0
333: END IF
334: CALL ZTPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB,
335: $ V( I, 1 ), LDV, T( 1, I ), LDT,
336: $ A( I, 1 ), LDA, B, LDB, WORK, IB )
337: END DO
338: *
339: ELSE IF( RIGHT .AND. NOTRAN ) THEN
340: *
341: KF = ((K-1)/MB)*MB+1
342: DO I = KF, 1, -MB
343: IB = MIN( MB, K-I+1 )
344: NB = MIN( N-L+I+IB-1, N )
345: IF( I.GE.L ) THEN
346: LB = 0
347: ELSE
348: LB = NB-N+L-I+1
349: END IF
350: CALL ZTPRFB( 'R', 'C', 'F', 'R', M, NB, IB, LB,
351: $ V( I, 1 ), LDV, T( 1, I ), LDT,
352: $ A( 1, I ), LDA, B, LDB, WORK, M )
353: END DO
354: *
355: END IF
356: *
357: RETURN
358: *
359: * End of ZTPMLQT
360: *
361: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ztpmlqt.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack