Annotation of rpl/lapack/lapack/dlarz.f, revision 1.2
1.1 bertrand 1: SUBROUTINE DLARZ( 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: 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'
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 )' * 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 )'
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 )'
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
CVSweb interface <joel.bertrand@systella.fr>