1: SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
2: *
3: * -- LAPACK routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
7: *
8: * .. Scalar Arguments ..
9: CHARACTER SIDE
10: INTEGER INCV, L, LDC, M, N
11: COMPLEX*16 TAU
12: * ..
13: * .. Array Arguments ..
14: COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
15: * ..
16: *
17: * Purpose
18: * =======
19: *
20: * ZLARZ applies a complex elementary reflector H to a complex
21: * M-by-N matrix C, from either the left or the right. H is represented
22: * in the form
23: *
24: * H = I - tau * v * v'
25: *
26: * where tau is a complex scalar and v is a complex vector.
27: *
28: * If tau = 0, then H is taken to be the unit matrix.
29: *
30: * To apply H' (the conjugate transpose of H), supply conjg(tau) instead
31: * tau.
32: *
33: * H is a product of k elementary reflectors as returned by ZTZRZF.
34: *
35: * Arguments
36: * =========
37: *
38: * SIDE (input) CHARACTER*1
39: * = 'L': form H * C
40: * = 'R': form C * H
41: *
42: * M (input) INTEGER
43: * The number of rows of the matrix C.
44: *
45: * N (input) INTEGER
46: * The number of columns of the matrix C.
47: *
48: * L (input) INTEGER
49: * The number of entries of the vector V containing
50: * the meaningful part of the Householder vectors.
51: * If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
52: *
53: * V (input) COMPLEX*16 array, dimension (1+(L-1)*abs(INCV))
54: * The vector v in the representation of H as returned by
55: * ZTZRZF. V is not used if TAU = 0.
56: *
57: * INCV (input) INTEGER
58: * The increment between elements of v. INCV <> 0.
59: *
60: * TAU (input) COMPLEX*16
61: * The value tau in the representation of H.
62: *
63: * C (input/output) COMPLEX*16 array, dimension (LDC,N)
64: * On entry, the M-by-N matrix C.
65: * On exit, C is overwritten by the matrix H * C if SIDE = 'L',
66: * or C * H if SIDE = 'R'.
67: *
68: * LDC (input) INTEGER
69: * The leading dimension of the array C. LDC >= max(1,M).
70: *
71: * WORK (workspace) COMPLEX*16 array, dimension
72: * (N) if SIDE = 'L'
73: * or (M) if SIDE = 'R'
74: *
75: * Further Details
76: * ===============
77: *
78: * Based on contributions by
79: * A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
80: *
81: * =====================================================================
82: *
83: * .. Parameters ..
84: COMPLEX*16 ONE, ZERO
85: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
86: $ ZERO = ( 0.0D+0, 0.0D+0 ) )
87: * ..
88: * .. External Subroutines ..
89: EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
90: * ..
91: * .. External Functions ..
92: LOGICAL LSAME
93: EXTERNAL LSAME
94: * ..
95: * .. Executable Statements ..
96: *
97: IF( LSAME( SIDE, 'L' ) ) THEN
98: *
99: * Form H * C
100: *
101: IF( TAU.NE.ZERO ) THEN
102: *
103: * w( 1:n ) = conjg( C( 1, 1:n ) )
104: *
105: CALL ZCOPY( N, C, LDC, WORK, 1 )
106: CALL ZLACGV( N, WORK, 1 )
107: *
108: * w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )' * v( 1:l ) )
109: *
110: CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ),
111: $ LDC, V, INCV, ONE, WORK, 1 )
112: CALL ZLACGV( N, WORK, 1 )
113: *
114: * C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
115: *
116: CALL ZAXPY( N, -TAU, WORK, 1, C, LDC )
117: *
118: * C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
119: * tau * v( 1:l ) * conjg( w( 1:n )' )
120: *
121: CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
122: $ LDC )
123: END IF
124: *
125: ELSE
126: *
127: * Form C * H
128: *
129: IF( TAU.NE.ZERO ) THEN
130: *
131: * w( 1:m ) = C( 1:m, 1 )
132: *
133: CALL ZCOPY( M, C, 1, WORK, 1 )
134: *
135: * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
136: *
137: CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
138: $ V, INCV, ONE, WORK, 1 )
139: *
140: * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
141: *
142: CALL ZAXPY( M, -TAU, WORK, 1, C, 1 )
143: *
144: * C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
145: * tau * w( 1:m ) * v( 1:l )'
146: *
147: CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
148: $ LDC )
149: *
150: END IF
151: *
152: END IF
153: *
154: RETURN
155: *
156: * End of ZLARZ
157: *
158: END
CVSweb interface <joel.bertrand@systella.fr>