1: *> \brief \b ZUNHR_COL
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZUNHR_COL + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunhr_col.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunhr_col.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunhr_col.f">
15: *> [TXT]</a
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO )
22: *
23: * .. Scalar Arguments ..
24: * INTEGER INFO, LDA, LDT, M, N, NB
25: * ..
26: * .. Array Arguments ..
27: * COMPLEX*16 A( LDA, * ), D( * ), T( LDT, * )
28: * ..
29: *
30: *> \par Purpose:
31: * =============
32: *>
33: *> \verbatim
34: *>
35: *> ZUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns
36: *> as input, stored in A, and performs Householder Reconstruction (HR),
37: *> i.e. reconstructs Householder vectors V(i) implicitly representing
38: *> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S,
39: *> where S is an N-by-N diagonal matrix with diagonal entries
40: *> equal to +1 or -1. The Householder vectors (columns V(i) of V) are
41: *> stored in A on output, and the diagonal entries of S are stored in D.
42: *> Block reflectors are also returned in T
43: *> (same output format as ZGEQRT).
44: *> \endverbatim
45: *
46: * Arguments:
47: * ==========
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 A. M >= N >= 0.
59: *> \endverbatim
60: *>
61: *> \param[in] NB
62: *> \verbatim
63: *> NB is INTEGER
64: *> The column block size to be used in the reconstruction
65: *> of Householder column vector blocks in the array A and
66: *> corresponding block reflectors in the array T. NB >= 1.
67: *> (Note that if NB > N, then N is used instead of NB
68: *> as the column block size.)
69: *> \endverbatim
70: *>
71: *> \param[in,out] A
72: *> \verbatim
73: *> A is COMPLEX*16 array, dimension (LDA,N)
74: *>
75: *> On entry:
76: *>
77: *> The array A contains an M-by-N orthonormal matrix Q_in,
78: *> i.e the columns of A are orthogonal unit vectors.
79: *>
80: *> On exit:
81: *>
82: *> The elements below the diagonal of A represent the unit
83: *> lower-trapezoidal matrix V of Householder column vectors
84: *> V(i). The unit diagonal entries of V are not stored
85: *> (same format as the output below the diagonal in A from
86: *> ZGEQRT). The matrix T and the matrix V stored on output
87: *> in A implicitly define Q_out.
88: *>
89: *> The elements above the diagonal contain the factor U
90: *> of the "modified" LU-decomposition:
91: *> Q_in - ( S ) = V * U
92: *> ( 0 )
93: *> where 0 is a (M-N)-by-(M-N) zero matrix.
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[out] T
103: *> \verbatim
104: *> T is COMPLEX*16 array,
105: *> dimension (LDT, N)
106: *>
107: *> Let NOCB = Number_of_output_col_blocks
108: *> = CEIL(N/NB)
109: *>
110: *> On exit, T(1:NB, 1:N) contains NOCB upper-triangular
111: *> block reflectors used to define Q_out stored in compact
112: *> form as a sequence of upper-triangular NB-by-NB column
113: *> blocks (same format as the output T in ZGEQRT).
114: *> The matrix T and the matrix V stored on output in A
115: *> implicitly define Q_out. NOTE: The lower triangles
116: *> below the upper-triangular blocks will be filled with
117: *> zeros. See Further Details.
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(NB,N)).
125: *> \endverbatim
126: *>
127: *> \param[out] D
128: *> \verbatim
129: *> D is COMPLEX*16 array, dimension min(M,N).
130: *> The elements can be only plus or minus one.
131: *>
132: *> D(i) is constructed as D(i) = -SIGN(Q_in_i(i,i)), where
133: *> 1 <= i <= min(M,N), and Q_in_i is Q_in after performing
134: *> i-1 steps of “modified” Gaussian elimination.
135: *> See Further Details.
136: *> \endverbatim
137: *>
138: *> \param[out] INFO
139: *> \verbatim
140: *> INFO is INTEGER
141: *> = 0: successful exit
142: *> < 0: if INFO = -i, the i-th argument had an illegal value
143: *> \endverbatim
144: *>
145: *> \par Further Details:
146: * =====================
147: *>
148: *> \verbatim
149: *>
150: *> The computed M-by-M unitary factor Q_out is defined implicitly as
151: *> a product of unitary matrices Q_out(i). Each Q_out(i) is stored in
152: *> the compact WY-representation format in the corresponding blocks of
153: *> matrices V (stored in A) and T.
154: *>
155: *> The M-by-N unit lower-trapezoidal matrix V stored in the M-by-N
156: *> matrix A contains the column vectors V(i) in NB-size column
157: *> blocks VB(j). For example, VB(1) contains the columns
158: *> V(1), V(2), ... V(NB). NOTE: The unit entries on
159: *> the diagonal of Y are not stored in A.
160: *>
161: *> The number of column blocks is
162: *>
163: *> NOCB = Number_of_output_col_blocks = CEIL(N/NB)
164: *>
165: *> where each block is of order NB except for the last block, which
166: *> is of order LAST_NB = N - (NOCB-1)*NB.
167: *>
168: *> For example, if M=6, N=5 and NB=2, the matrix V is
169: *>
170: *>
171: *> V = ( VB(1), VB(2), VB(3) ) =
172: *>
173: *> = ( 1 )
174: *> ( v21 1 )
175: *> ( v31 v32 1 )
176: *> ( v41 v42 v43 1 )
177: *> ( v51 v52 v53 v54 1 )
178: *> ( v61 v62 v63 v54 v65 )
179: *>
180: *>
181: *> For each of the column blocks VB(i), an upper-triangular block
182: *> reflector TB(i) is computed. These blocks are stored as
183: *> a sequence of upper-triangular column blocks in the NB-by-N
184: *> matrix T. The size of each TB(i) block is NB-by-NB, except
185: *> for the last block, whose size is LAST_NB-by-LAST_NB.
186: *>
187: *> For example, if M=6, N=5 and NB=2, the matrix T is
188: *>
189: *> T = ( TB(1), TB(2), TB(3) ) =
190: *>
191: *> = ( t11 t12 t13 t14 t15 )
192: *> ( t22 t24 )
193: *>
194: *>
195: *> The M-by-M factor Q_out is given as a product of NOCB
196: *> unitary M-by-M matrices Q_out(i).
197: *>
198: *> Q_out = Q_out(1) * Q_out(2) * ... * Q_out(NOCB),
199: *>
200: *> where each matrix Q_out(i) is given by the WY-representation
201: *> using corresponding blocks from the matrices V and T:
202: *>
203: *> Q_out(i) = I - VB(i) * TB(i) * (VB(i))**T,
204: *>
205: *> where I is the identity matrix. Here is the formula with matrix
206: *> dimensions:
207: *>
208: *> Q(i){M-by-M} = I{M-by-M} -
209: *> VB(i){M-by-INB} * TB(i){INB-by-INB} * (VB(i))**T {INB-by-M},
210: *>
211: *> where INB = NB, except for the last block NOCB
212: *> for which INB=LAST_NB.
213: *>
214: *> =====
215: *> NOTE:
216: *> =====
217: *>
218: *> If Q_in is the result of doing a QR factorization
219: *> B = Q_in * R_in, then:
220: *>
221: *> B = (Q_out*S) * R_in = Q_out * (S * R_in) = Q_out * R_out.
222: *>
223: *> So if one wants to interpret Q_out as the result
224: *> of the QR factorization of B, then the corresponding R_out
225: *> should be equal to R_out = S * R_in, i.e. some rows of R_in
226: *> should be multiplied by -1.
227: *>
228: *> For the details of the algorithm, see [1].
229: *>
230: *> [1] "Reconstructing Householder vectors from tall-skinny QR",
231: *> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen,
232: *> E. Solomonik, J. Parallel Distrib. Comput.,
233: *> vol. 85, pp. 3-31, 2015.
234: *> \endverbatim
235: *>
236: * Authors:
237: * ========
238: *
239: *> \author Univ. of Tennessee
240: *> \author Univ. of California Berkeley
241: *> \author Univ. of Colorado Denver
242: *> \author NAG Ltd.
243: *
244: *> \ingroup complex16OTHERcomputational
245: *
246: *> \par Contributors:
247: * ==================
248: *>
249: *> \verbatim
250: *>
251: *> November 2019, Igor Kozachenko,
252: *> Computer Science Division,
253: *> University of California, Berkeley
254: *>
255: *> \endverbatim
256: *
257: * =====================================================================
258: SUBROUTINE ZUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO )
259: IMPLICIT NONE
260: *
261: * -- LAPACK computational routine --
262: * -- LAPACK is a software package provided by Univ. of Tennessee, --
263: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
264: *
265: * .. Scalar Arguments ..
266: INTEGER INFO, LDA, LDT, M, N, NB
267: * ..
268: * .. Array Arguments ..
269: COMPLEX*16 A( LDA, * ), D( * ), T( LDT, * )
270: * ..
271: *
272: * =====================================================================
273: *
274: * .. Parameters ..
275: COMPLEX*16 CONE, CZERO
276: PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ),
277: $ CZERO = ( 0.0D+0, 0.0D+0 ) )
278: * ..
279: * .. Local Scalars ..
280: INTEGER I, IINFO, J, JB, JBTEMP1, JBTEMP2, JNB,
281: $ NPLUSONE
282: * ..
283: * .. External Subroutines ..
284: EXTERNAL ZCOPY, ZLAUNHR_COL_GETRFNP, ZSCAL, ZTRSM,
285: $ XERBLA
286: * ..
287: * .. Intrinsic Functions ..
288: INTRINSIC MAX, MIN
289: * ..
290: * .. Executable Statements ..
291: *
292: * Test the input parameters
293: *
294: INFO = 0
295: IF( M.LT.0 ) THEN
296: INFO = -1
297: ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
298: INFO = -2
299: ELSE IF( NB.LT.1 ) THEN
300: INFO = -3
301: ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
302: INFO = -5
303: ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN
304: INFO = -7
305: END IF
306: *
307: * Handle error in the input parameters.
308: *
309: IF( INFO.NE.0 ) THEN
310: CALL XERBLA( 'ZUNHR_COL', -INFO )
311: RETURN
312: END IF
313: *
314: * Quick return if possible
315: *
316: IF( MIN( M, N ).EQ.0 ) THEN
317: RETURN
318: END IF
319: *
320: * On input, the M-by-N matrix A contains the unitary
321: * M-by-N matrix Q_in.
322: *
323: * (1) Compute the unit lower-trapezoidal V (ones on the diagonal
324: * are not stored) by performing the "modified" LU-decomposition.
325: *
326: * Q_in - ( S ) = V * U = ( V1 ) * U,
327: * ( 0 ) ( V2 )
328: *
329: * where 0 is an (M-N)-by-N zero matrix.
330: *
331: * (1-1) Factor V1 and U.
332:
333: CALL ZLAUNHR_COL_GETRFNP( N, N, A, LDA, D, IINFO )
334: *
335: * (1-2) Solve for V2.
336: *
337: IF( M.GT.N ) THEN
338: CALL ZTRSM( 'R', 'U', 'N', 'N', M-N, N, CONE, A, LDA,
339: $ A( N+1, 1 ), LDA )
340: END IF
341: *
342: * (2) Reconstruct the block reflector T stored in T(1:NB, 1:N)
343: * as a sequence of upper-triangular blocks with NB-size column
344: * blocking.
345: *
346: * Loop over the column blocks of size NB of the array A(1:M,1:N)
347: * and the array T(1:NB,1:N), JB is the column index of a column
348: * block, JNB is the column block size at each step JB.
349: *
350: NPLUSONE = N + 1
351: DO JB = 1, N, NB
352: *
353: * (2-0) Determine the column block size JNB.
354: *
355: JNB = MIN( NPLUSONE-JB, NB )
356: *
357: * (2-1) Copy the upper-triangular part of the current JNB-by-JNB
358: * diagonal block U(JB) (of the N-by-N matrix U) stored
359: * in A(JB:JB+JNB-1,JB:JB+JNB-1) into the upper-triangular part
360: * of the current JNB-by-JNB block T(1:JNB,JB:JB+JNB-1)
361: * column-by-column, total JNB*(JNB+1)/2 elements.
362: *
363: JBTEMP1 = JB - 1
364: DO J = JB, JB+JNB-1
365: CALL ZCOPY( J-JBTEMP1, A( JB, J ), 1, T( 1, J ), 1 )
366: END DO
367: *
368: * (2-2) Perform on the upper-triangular part of the current
369: * JNB-by-JNB diagonal block U(JB) (of the N-by-N matrix U) stored
370: * in T(1:JNB,JB:JB+JNB-1) the following operation in place:
371: * (-1)*U(JB)*S(JB), i.e the result will be stored in the upper-
372: * triangular part of T(1:JNB,JB:JB+JNB-1). This multiplication
373: * of the JNB-by-JNB diagonal block U(JB) by the JNB-by-JNB
374: * diagonal block S(JB) of the N-by-N sign matrix S from the
375: * right means changing the sign of each J-th column of the block
376: * U(JB) according to the sign of the diagonal element of the block
377: * S(JB), i.e. S(J,J) that is stored in the array element D(J).
378: *
379: DO J = JB, JB+JNB-1
380: IF( D( J ).EQ.CONE ) THEN
381: CALL ZSCAL( J-JBTEMP1, -CONE, T( 1, J ), 1 )
382: END IF
383: END DO
384: *
385: * (2-3) Perform the triangular solve for the current block
386: * matrix X(JB):
387: *
388: * X(JB) * (A(JB)**T) = B(JB), where:
389: *
390: * A(JB)**T is a JNB-by-JNB unit upper-triangular
391: * coefficient block, and A(JB)=V1(JB), which
392: * is a JNB-by-JNB unit lower-triangular block
393: * stored in A(JB:JB+JNB-1,JB:JB+JNB-1).
394: * The N-by-N matrix V1 is the upper part
395: * of the M-by-N lower-trapezoidal matrix V
396: * stored in A(1:M,1:N);
397: *
398: * B(JB) is a JNB-by-JNB upper-triangular right-hand
399: * side block, B(JB) = (-1)*U(JB)*S(JB), and
400: * B(JB) is stored in T(1:JNB,JB:JB+JNB-1);
401: *
402: * X(JB) is a JNB-by-JNB upper-triangular solution
403: * block, X(JB) is the upper-triangular block
404: * reflector T(JB), and X(JB) is stored
405: * in T(1:JNB,JB:JB+JNB-1).
406: *
407: * In other words, we perform the triangular solve for the
408: * upper-triangular block T(JB):
409: *
410: * T(JB) * (V1(JB)**T) = (-1)*U(JB)*S(JB).
411: *
412: * Even though the blocks X(JB) and B(JB) are upper-
413: * triangular, the routine ZTRSM will access all JNB**2
414: * elements of the square T(1:JNB,JB:JB+JNB-1). Therefore,
415: * we need to set to zero the elements of the block
416: * T(1:JNB,JB:JB+JNB-1) below the diagonal before the call
417: * to ZTRSM.
418: *
419: * (2-3a) Set the elements to zero.
420: *
421: JBTEMP2 = JB - 2
422: DO J = JB, JB+JNB-2
423: DO I = J-JBTEMP2, NB
424: T( I, J ) = CZERO
425: END DO
426: END DO
427: *
428: * (2-3b) Perform the triangular solve.
429: *
430: CALL ZTRSM( 'R', 'L', 'C', 'U', JNB, JNB, CONE,
431: $ A( JB, JB ), LDA, T( 1, JB ), LDT )
432: *
433: END DO
434: *
435: RETURN
436: *
437: * End of ZUNHR_COL
438: *
439: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zunhr_col.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack