Annotation of rpl/lapack/lapack/zgelqt3.f, revision 1.5
1.1 bertrand 1: *> \brief \b ZGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact WY representation of Q.
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
1.5 ! bertrand 9: *> Download ZGELQT3 + dependencies
1.1 bertrand 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqt3.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqt3.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqt3.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * RECURSIVE SUBROUTINE ZGELQT3( M, N, A, LDA, T, LDT, INFO )
22: *
23: * .. Scalar Arguments ..
24: * INTEGER INFO, LDA, M, N, LDT
25: * ..
26: * .. Array Arguments ..
27: * COMPLEX*16 A( LDA, * ), T( LDT, * )
28: * ..
29: *
30: *
31: *> \par Purpose:
32: * =============
33: *>
34: *> \verbatim
35: *>
1.5 ! bertrand 36: *> ZGELQT3 recursively computes a LQ factorization of a complex M-by-N
1.1 bertrand 37: *> matrix A, using the compact WY representation of Q.
38: *>
39: *> Based on the algorithm of Elmroth and Gustavson,
40: *> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
41: *> \endverbatim
42: *
43: * Arguments:
44: * ==========
45: *
46: *> \param[in] M
47: *> \verbatim
48: *> M is INTEGER
49: *> The number of rows of the matrix A. M =< N.
50: *> \endverbatim
51: *>
52: *> \param[in] N
53: *> \verbatim
54: *> N is INTEGER
55: *> The number of columns of the matrix A. N >= 0.
56: *> \endverbatim
57: *>
58: *> \param[in,out] A
59: *> \verbatim
60: *> A is COMPLEX*16 array, dimension (LDA,N)
1.5 ! bertrand 61: *> On entry, the complex M-by-N matrix A. On exit, the elements on and
1.1 bertrand 62: *> below the diagonal contain the N-by-N lower triangular matrix L; the
63: *> elements above the diagonal are the rows of V. See below for
64: *> further details.
65: *> \endverbatim
66: *>
67: *> \param[in] LDA
68: *> \verbatim
69: *> LDA is INTEGER
70: *> The leading dimension of the array A. LDA >= max(1,M).
71: *> \endverbatim
72: *>
73: *> \param[out] T
74: *> \verbatim
75: *> T is COMPLEX*16 array, dimension (LDT,N)
76: *> The N-by-N upper triangular factor of the block reflector.
77: *> The elements on and above the diagonal contain the block
78: *> reflector T; the elements below the diagonal are not used.
79: *> See below for further details.
80: *> \endverbatim
81: *>
82: *> \param[in] LDT
83: *> \verbatim
84: *> LDT is INTEGER
85: *> The leading dimension of the array T. LDT >= max(1,N).
86: *> \endverbatim
87: *>
88: *> \param[out] INFO
89: *> \verbatim
90: *> INFO is INTEGER
91: *> = 0: successful exit
92: *> < 0: if INFO = -i, the i-th argument had an illegal value
93: *> \endverbatim
94: *
95: * Authors:
96: * ========
97: *
98: *> \author Univ. of Tennessee
99: *> \author Univ. of California Berkeley
100: *> \author Univ. of Colorado Denver
101: *> \author NAG Ltd.
102: *
103: *> \ingroup doubleGEcomputational
104: *
105: *> \par Further Details:
106: * =====================
107: *>
108: *> \verbatim
109: *>
1.3 bertrand 110: *> The matrix V stores the elementary reflectors H(i) in the i-th row
111: *> above the diagonal. For example, if M=5 and N=3, the matrix V is
1.1 bertrand 112: *>
113: *> V = ( 1 v1 v1 v1 v1 )
114: *> ( 1 v2 v2 v2 )
115: *> ( 1 v3 v3 v3 )
116: *>
117: *>
118: *> where the vi's represent the vectors which define H(i), which are returned
119: *> in the matrix A. The 1's along the diagonal of V are not stored in A. The
120: *> block reflector H is then given by
121: *>
122: *> H = I - V * T * V**T
123: *>
124: *> where V**T is the transpose of V.
125: *>
126: *> For details of the algorithm, see Elmroth and Gustavson (cited above).
127: *> \endverbatim
128: *>
129: * =====================================================================
130: RECURSIVE SUBROUTINE ZGELQT3( M, N, A, LDA, T, LDT, INFO )
131: *
1.5 ! bertrand 132: * -- LAPACK computational routine --
1.1 bertrand 133: * -- LAPACK is a software package provided by Univ. of Tennessee, --
134: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
135: *
136: * .. Scalar Arguments ..
137: INTEGER INFO, LDA, M, N, LDT
138: * ..
139: * .. Array Arguments ..
140: COMPLEX*16 A( LDA, * ), T( LDT, * )
141: * ..
142: *
143: * =====================================================================
144: *
145: * .. Parameters ..
146: COMPLEX*16 ONE, ZERO
147: PARAMETER ( ONE = (1.0D+00,0.0D+00) )
148: PARAMETER ( ZERO = (0.0D+00,0.0D+00))
149: * ..
150: * .. Local Scalars ..
1.3 bertrand 151: INTEGER I, I1, J, J1, M1, M2, IINFO
1.1 bertrand 152: * ..
153: * .. External Subroutines ..
154: EXTERNAL ZLARFG, ZTRMM, ZGEMM, XERBLA
155: * ..
156: * .. Executable Statements ..
157: *
158: INFO = 0
159: IF( M .LT. 0 ) THEN
160: INFO = -1
161: ELSE IF( N .LT. M ) THEN
162: INFO = -2
163: ELSE IF( LDA .LT. MAX( 1, M ) ) THEN
164: INFO = -4
165: ELSE IF( LDT .LT. MAX( 1, M ) ) THEN
166: INFO = -6
167: END IF
168: IF( INFO.NE.0 ) THEN
169: CALL XERBLA( 'ZGELQT3', -INFO )
170: RETURN
171: END IF
172: *
173: IF( M.EQ.1 ) THEN
174: *
1.5 ! bertrand 175: * Compute Householder transform when M=1
1.1 bertrand 176: *
177: CALL ZLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
178: T(1,1)=CONJG(T(1,1))
179: *
180: ELSE
181: *
182: * Otherwise, split A into blocks...
183: *
184: M1 = M/2
185: M2 = M-M1
186: I1 = MIN( M1+1, M )
187: J1 = MIN( M+1, N )
188: *
189: * Compute A(1:M1,1:N) <- (Y1,R1,T1), where Q1 = I - Y1 T1 Y1^H
190: *
191: CALL ZGELQT3( M1, N, A, LDA, T, LDT, IINFO )
192: *
193: * Compute A(J1:M,1:N) = A(J1:M,1:N) Q1^H [workspace: T(1:N1,J1:N)]
194: *
195: DO I=1,M2
196: DO J=1,M1
197: T( I+M1, J ) = A( I+M1, J )
198: END DO
199: END DO
200: CALL ZTRMM( 'R', 'U', 'C', 'U', M2, M1, ONE,
201: & A, LDA, T( I1, 1 ), LDT )
202: *
203: CALL ZGEMM( 'N', 'C', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
204: & A( 1, I1 ), LDA, ONE, T( I1, 1 ), LDT)
205: *
206: CALL ZTRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
207: & T, LDT, T( I1, 1 ), LDT )
208: *
209: CALL ZGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,
210: & A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
211: *
212: CALL ZTRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
213: & A, LDA, T( I1, 1 ), LDT )
214: *
215: DO I=1,M2
216: DO J=1,M1
217: A( I+M1, J ) = A( I+M1, J ) - T( I+M1, J )
218: T( I+M1, J )= ZERO
219: END DO
220: END DO
221: *
222: * Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
223: *
224: CALL ZGELQT3( M2, N-M1, A( I1, I1 ), LDA,
225: & T( I1, I1 ), LDT, IINFO )
226: *
227: * Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
228: *
229: DO I=1,M2
230: DO J=1,M1
231: T( J, I+M1 ) = (A( J, I+M1 ))
232: END DO
233: END DO
234: *
235: CALL ZTRMM( 'R', 'U', 'C', 'U', M1, M2, ONE,
236: & A( I1, I1 ), LDA, T( 1, I1 ), LDT )
237: *
238: CALL ZGEMM( 'N', 'C', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
239: & A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
240: *
241: CALL ZTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT,
242: & T( 1, I1 ), LDT )
243: *
244: CALL ZTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE,
245: & T( I1, I1 ), LDT, T( 1, I1 ), LDT )
246: *
247: *
248: *
249: * Y = (Y1,Y2); L = [ L1 0 ]; T = [T1 T3]
250: * [ A(1:N1,J1:N) L2 ] [ 0 T2]
251: *
252: END IF
253: *
254: RETURN
255: *
256: * End of ZGELQT3
257: *
258: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zgelqt3.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack