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