1: *> \brief \b ZUNGTSQR
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZUNGTSQR + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zuntsqr.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungtsqr.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungtsqr.f">
15: *> [TXT]</a>
16: *>
17: * Definition:
18: * ===========
19: *
20: * SUBROUTINE ZUNGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
21: * $ INFO )
22: *
23: * .. Scalar Arguments ..
24: * INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB
25: * ..
26: * .. Array Arguments ..
27: * COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * )
28: * ..
29: *
30: *> \par Purpose:
31: * =============
32: *>
33: *> \verbatim
34: *>
35: *> ZUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal
36: *> columns, which are the first N columns of a product of comlpex unitary
37: *> matrices of order M which are returned by ZLATSQR
38: *>
39: *> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ).
40: *>
41: *> See the documentation for ZLATSQR.
42: *> \endverbatim
43: *
44: * Arguments:
45: * ==========
46: *
47: *> \param[in] M
48: *> \verbatim
49: *> M is INTEGER
50: *> The number of rows of the matrix A. M >= 0.
51: *> \endverbatim
52: *>
53: *> \param[in] N
54: *> \verbatim
55: *> N is INTEGER
56: *> The number of columns of the matrix A. M >= N >= 0.
57: *> \endverbatim
58: *>
59: *> \param[in] MB
60: *> \verbatim
61: *> MB is INTEGER
62: *> The row block size used by DLATSQR to return
63: *> arrays A and T. MB > N.
64: *> (Note that if MB > M, then M is used instead of MB
65: *> as the row block size).
66: *> \endverbatim
67: *>
68: *> \param[in] NB
69: *> \verbatim
70: *> NB is INTEGER
71: *> The column block size used by ZLATSQR to return
72: *> arrays A and T. NB >= 1.
73: *> (Note that if NB > N, then N is used instead of NB
74: *> as the column block size).
75: *> \endverbatim
76: *>
77: *> \param[in,out] A
78: *> \verbatim
79: *> A is COMPLEX*16 array, dimension (LDA,N)
80: *>
81: *> On entry:
82: *>
83: *> The elements on and above the diagonal are not accessed.
84: *> The elements below the diagonal represent the unit
85: *> lower-trapezoidal blocked matrix V computed by ZLATSQR
86: *> that defines the input matrices Q_in(k) (ones on the
87: *> diagonal are not stored) (same format as the output A
88: *> below the diagonal in ZLATSQR).
89: *>
90: *> On exit:
91: *>
92: *> The array A contains an M-by-N orthonormal matrix Q_out,
93: *> i.e the columns of A are orthogonal unit vectors.
94: *> \endverbatim
95: *>
96: *> \param[in] LDA
97: *> \verbatim
98: *> LDA is INTEGER
99: *> The leading dimension of the array A. LDA >= max(1,M).
100: *> \endverbatim
101: *>
102: *> \param[in] T
103: *> \verbatim
104: *> T is COMPLEX*16 array,
105: *> dimension (LDT, N * NIRB)
106: *> where NIRB = Number_of_input_row_blocks
107: *> = MAX( 1, CEIL((M-N)/(MB-N)) )
108: *> Let NICB = Number_of_input_col_blocks
109: *> = CEIL(N/NB)
110: *>
111: *> The upper-triangular block reflectors used to define the
112: *> input matrices Q_in(k), k=(1:NIRB*NICB). The block
113: *> reflectors are stored in compact form in NIRB block
114: *> reflector sequences. Each of NIRB block reflector sequences
115: *> is stored in a larger NB-by-N column block of T and consists
116: *> of NICB smaller NB-by-NB upper-triangular column blocks.
117: *> (same format as the output T in ZLATSQR).
118: *> \endverbatim
119: *>
120: *> \param[in] LDT
121: *> \verbatim
122: *> LDT is INTEGER
123: *> The leading dimension of the array T.
124: *> LDT >= max(1,min(NB1,N)).
125: *> \endverbatim
126: *>
127: *> \param[out] WORK
128: *> \verbatim
129: *> (workspace) COMPLEX*16 array, dimension (MAX(2,LWORK))
130: *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
131: *> \endverbatim
132: *>
133: *> \param[in] LWORK
134: *> \verbatim
135: *> The dimension of the array WORK. LWORK >= (M+NB)*N.
136: *> If LWORK = -1, then a workspace query is assumed.
137: *> The routine only calculates the optimal size of the WORK
138: *> array, returns this value as the first entry of the WORK
139: *> array, and no error message related to LWORK is issued
140: *> by XERBLA.
141: *> \endverbatim
142: *>
143: *> \param[out] INFO
144: *> \verbatim
145: *> INFO is INTEGER
146: *> = 0: successful exit
147: *> < 0: if INFO = -i, the i-th argument had an illegal value
148: *> \endverbatim
149: *>
150: * Authors:
151: * ========
152: *
153: *> \author Univ. of Tennessee
154: *> \author Univ. of California Berkeley
155: *> \author Univ. of Colorado Denver
156: *> \author NAG Ltd.
157: *
158: *> \date November 2019
159: *
160: *> \ingroup comlex16OTHERcomputational
161: *
162: *> \par Contributors:
163: * ==================
164: *>
165: *> \verbatim
166: *>
167: *> November 2019, Igor Kozachenko,
168: *> Computer Science Division,
169: *> University of California, Berkeley
170: *>
171: *> \endverbatim
172: *
173: * =====================================================================
174: SUBROUTINE ZUNGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
175: $ INFO )
176: IMPLICIT NONE
177: *
178: * -- LAPACK computational routine (version 3.9.0) --
179: * -- LAPACK is a software package provided by Univ. of Tennessee, --
180: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
181: * November 2019
182: *
183: * .. Scalar Arguments ..
184: INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB
185: * ..
186: * .. Array Arguments ..
187: COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * )
188: * ..
189: *
190: * =====================================================================
191: *
192: * .. Parameters ..
193: COMPLEX*16 CONE, CZERO
194: PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ),
195: $ CZERO = ( 0.0D+0, 0.0D+0 ) )
196: * ..
197: * .. Local Scalars ..
198: LOGICAL LQUERY
199: INTEGER IINFO, LDC, LWORKOPT, LC, LW, NBLOCAL, J
200: * ..
201: * .. External Subroutines ..
202: EXTERNAL ZCOPY, ZLAMTSQR, ZLASET, XERBLA
203: * ..
204: * .. Intrinsic Functions ..
205: INTRINSIC DCMPLX, MAX, MIN
206: * ..
207: * .. Executable Statements ..
208: *
209: * Test the input parameters
210: *
211: LQUERY = LWORK.EQ.-1
212: INFO = 0
213: IF( M.LT.0 ) THEN
214: INFO = -1
215: ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
216: INFO = -2
217: ELSE IF( MB.LE.N ) THEN
218: INFO = -3
219: ELSE IF( NB.LT.1 ) THEN
220: INFO = -4
221: ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
222: INFO = -6
223: ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN
224: INFO = -8
225: ELSE
226: *
227: * Test the input LWORK for the dimension of the array WORK.
228: * This workspace is used to store array C(LDC, N) and WORK(LWORK)
229: * in the call to ZLAMTSQR. See the documentation for ZLAMTSQR.
230: *
231: IF( LWORK.LT.2 .AND. (.NOT.LQUERY) ) THEN
232: INFO = -10
233: ELSE
234: *
235: * Set block size for column blocks
236: *
237: NBLOCAL = MIN( NB, N )
238: *
239: * LWORK = -1, then set the size for the array C(LDC,N)
240: * in ZLAMTSQR call and set the optimal size of the work array
241: * WORK(LWORK) in ZLAMTSQR call.
242: *
243: LDC = M
244: LC = LDC*N
245: LW = N * NBLOCAL
246: *
247: LWORKOPT = LC+LW
248: *
249: IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN
250: INFO = -10
251: END IF
252: END IF
253: *
254: END IF
255: *
256: * Handle error in the input parameters and return workspace query.
257: *
258: IF( INFO.NE.0 ) THEN
259: CALL XERBLA( 'ZUNGTSQR', -INFO )
260: RETURN
261: ELSE IF ( LQUERY ) THEN
262: WORK( 1 ) = DCMPLX( LWORKOPT )
263: RETURN
264: END IF
265: *
266: * Quick return if possible
267: *
268: IF( MIN( M, N ).EQ.0 ) THEN
269: WORK( 1 ) = DCMPLX( LWORKOPT )
270: RETURN
271: END IF
272: *
273: * (1) Form explicitly the tall-skinny M-by-N left submatrix Q1_in
274: * of M-by-M orthogonal matrix Q_in, which is implicitly stored in
275: * the subdiagonal part of input array A and in the input array T.
276: * Perform by the following operation using the routine ZLAMTSQR.
277: *
278: * Q1_in = Q_in * ( I ), where I is a N-by-N identity matrix,
279: * ( 0 ) 0 is a (M-N)-by-N zero matrix.
280: *
281: * (1a) Form M-by-N matrix in the array WORK(1:LDC*N) with ones
282: * on the diagonal and zeros elsewhere.
283: *
284: CALL ZLASET( 'F', M, N, CZERO, CONE, WORK, LDC )
285: *
286: * (1b) On input, WORK(1:LDC*N) stores ( I );
287: * ( 0 )
288: *
289: * On output, WORK(1:LDC*N) stores Q1_in.
290: *
291: CALL ZLAMTSQR( 'L', 'N', M, N, N, MB, NBLOCAL, A, LDA, T, LDT,
292: $ WORK, LDC, WORK( LC+1 ), LW, IINFO )
293: *
294: * (2) Copy the result from the part of the work array (1:M,1:N)
295: * with the leading dimension LDC that starts at WORK(1) into
296: * the output array A(1:M,1:N) column-by-column.
297: *
298: DO J = 1, N
299: CALL ZCOPY( M, WORK( (J-1)*LDC + 1 ), 1, A( 1, J ), 1 )
300: END DO
301: *
302: WORK( 1 ) = DCMPLX( LWORKOPT )
303: RETURN
304: *
305: * End of ZUNGTSQR
306: *
307: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zungtsqr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack