1 SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
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**H
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**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 )**H * 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 ) * w( 1:n )**H
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 )**H
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
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
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**H
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**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 )**H * 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 ) * w( 1:n )**H
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 )**H
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