1 SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, 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, LDC, M, N
11 DOUBLE PRECISION TAU
12 * ..
13 * .. Array Arguments ..
14 DOUBLE PRECISION C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * This routine is deprecated and has been replaced by routine DORMRZ.
21 *
22 * DLATZM applies a Householder matrix generated by DTZRQF to a matrix.
23 *
24 * Let P = I - tau*u*u**T, u = ( 1 ),
25 * ( v )
26 * where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
27 * SIDE = 'R'.
28 *
29 * If SIDE equals 'L', let
30 * C = [ C1 ] 1
31 * [ C2 ] m-1
32 * n
33 * Then C is overwritten by P*C.
34 *
35 * If SIDE equals 'R', let
36 * C = [ C1, C2 ] m
37 * 1 n-1
38 * Then C is overwritten by C*P.
39 *
40 * Arguments
41 * =========
42 *
43 * SIDE (input) CHARACTER*1
44 * = 'L': form P * C
45 * = 'R': form C * P
46 *
47 * M (input) INTEGER
48 * The number of rows of the matrix C.
49 *
50 * N (input) INTEGER
51 * The number of columns of the matrix C.
52 *
53 * V (input) DOUBLE PRECISION array, dimension
54 * (1 + (M-1)*abs(INCV)) if SIDE = 'L'
55 * (1 + (N-1)*abs(INCV)) if SIDE = 'R'
56 * The vector v in the representation of P. V is not used
57 * if TAU = 0.
58 *
59 * INCV (input) INTEGER
60 * The increment between elements of v. INCV <> 0
61 *
62 * TAU (input) DOUBLE PRECISION
63 * The value tau in the representation of P.
64 *
65 * C1 (input/output) DOUBLE PRECISION array, dimension
66 * (LDC,N) if SIDE = 'L'
67 * (M,1) if SIDE = 'R'
68 * On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
69 * if SIDE = 'R'.
70 *
71 * On exit, the first row of P*C if SIDE = 'L', or the first
72 * column of C*P if SIDE = 'R'.
73 *
74 * C2 (input/output) DOUBLE PRECISION array, dimension
75 * (LDC, N) if SIDE = 'L'
76 * (LDC, N-1) if SIDE = 'R'
77 * On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
78 * m x (n - 1) matrix C2 if SIDE = 'R'.
79 *
80 * On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
81 * if SIDE = 'R'.
82 *
83 * LDC (input) INTEGER
84 * The leading dimension of the arrays C1 and C2. LDC >= (1,M).
85 *
86 * WORK (workspace) DOUBLE PRECISION array, dimension
87 * (N) if SIDE = 'L'
88 * (M) if SIDE = 'R'
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 DOUBLE PRECISION ONE, ZERO
94 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
95 * ..
96 * .. External Subroutines ..
97 EXTERNAL DAXPY, DCOPY, DGEMV, DGER
98 * ..
99 * .. External Functions ..
100 LOGICAL LSAME
101 EXTERNAL LSAME
102 * ..
103 * .. Intrinsic Functions ..
104 INTRINSIC MIN
105 * ..
106 * .. Executable Statements ..
107 *
108 IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
109 $ RETURN
110 *
111 IF( LSAME( SIDE, 'L' ) ) THEN
112 *
113 * w := (C1 + v**T * C2)**T
114 *
115 CALL DCOPY( N, C1, LDC, WORK, 1 )
116 CALL DGEMV( 'Transpose', M-1, N, ONE, C2, LDC, V, INCV, ONE,
117 $ WORK, 1 )
118 *
119 * [ C1 ] := [ C1 ] - tau* [ 1 ] * w**T
120 * [ C2 ] [ C2 ] [ v ]
121 *
122 CALL DAXPY( N, -TAU, WORK, 1, C1, LDC )
123 CALL DGER( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
124 *
125 ELSE IF( LSAME( SIDE, 'R' ) ) THEN
126 *
127 * w := C1 + C2 * v
128 *
129 CALL DCOPY( M, C1, 1, WORK, 1 )
130 CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
131 $ WORK, 1 )
132 *
133 * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T]
134 *
135 CALL DAXPY( M, -TAU, WORK, 1, C1, 1 )
136 CALL DGER( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
137 END IF
138 *
139 RETURN
140 *
141 * End of DLATZM
142 *
143 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, LDC, M, N
11 DOUBLE PRECISION TAU
12 * ..
13 * .. Array Arguments ..
14 DOUBLE PRECISION C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * This routine is deprecated and has been replaced by routine DORMRZ.
21 *
22 * DLATZM applies a Householder matrix generated by DTZRQF to a matrix.
23 *
24 * Let P = I - tau*u*u**T, u = ( 1 ),
25 * ( v )
26 * where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
27 * SIDE = 'R'.
28 *
29 * If SIDE equals 'L', let
30 * C = [ C1 ] 1
31 * [ C2 ] m-1
32 * n
33 * Then C is overwritten by P*C.
34 *
35 * If SIDE equals 'R', let
36 * C = [ C1, C2 ] m
37 * 1 n-1
38 * Then C is overwritten by C*P.
39 *
40 * Arguments
41 * =========
42 *
43 * SIDE (input) CHARACTER*1
44 * = 'L': form P * C
45 * = 'R': form C * P
46 *
47 * M (input) INTEGER
48 * The number of rows of the matrix C.
49 *
50 * N (input) INTEGER
51 * The number of columns of the matrix C.
52 *
53 * V (input) DOUBLE PRECISION array, dimension
54 * (1 + (M-1)*abs(INCV)) if SIDE = 'L'
55 * (1 + (N-1)*abs(INCV)) if SIDE = 'R'
56 * The vector v in the representation of P. V is not used
57 * if TAU = 0.
58 *
59 * INCV (input) INTEGER
60 * The increment between elements of v. INCV <> 0
61 *
62 * TAU (input) DOUBLE PRECISION
63 * The value tau in the representation of P.
64 *
65 * C1 (input/output) DOUBLE PRECISION array, dimension
66 * (LDC,N) if SIDE = 'L'
67 * (M,1) if SIDE = 'R'
68 * On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
69 * if SIDE = 'R'.
70 *
71 * On exit, the first row of P*C if SIDE = 'L', or the first
72 * column of C*P if SIDE = 'R'.
73 *
74 * C2 (input/output) DOUBLE PRECISION array, dimension
75 * (LDC, N) if SIDE = 'L'
76 * (LDC, N-1) if SIDE = 'R'
77 * On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
78 * m x (n - 1) matrix C2 if SIDE = 'R'.
79 *
80 * On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
81 * if SIDE = 'R'.
82 *
83 * LDC (input) INTEGER
84 * The leading dimension of the arrays C1 and C2. LDC >= (1,M).
85 *
86 * WORK (workspace) DOUBLE PRECISION array, dimension
87 * (N) if SIDE = 'L'
88 * (M) if SIDE = 'R'
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 DOUBLE PRECISION ONE, ZERO
94 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
95 * ..
96 * .. External Subroutines ..
97 EXTERNAL DAXPY, DCOPY, DGEMV, DGER
98 * ..
99 * .. External Functions ..
100 LOGICAL LSAME
101 EXTERNAL LSAME
102 * ..
103 * .. Intrinsic Functions ..
104 INTRINSIC MIN
105 * ..
106 * .. Executable Statements ..
107 *
108 IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
109 $ RETURN
110 *
111 IF( LSAME( SIDE, 'L' ) ) THEN
112 *
113 * w := (C1 + v**T * C2)**T
114 *
115 CALL DCOPY( N, C1, LDC, WORK, 1 )
116 CALL DGEMV( 'Transpose', M-1, N, ONE, C2, LDC, V, INCV, ONE,
117 $ WORK, 1 )
118 *
119 * [ C1 ] := [ C1 ] - tau* [ 1 ] * w**T
120 * [ C2 ] [ C2 ] [ v ]
121 *
122 CALL DAXPY( N, -TAU, WORK, 1, C1, LDC )
123 CALL DGER( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
124 *
125 ELSE IF( LSAME( SIDE, 'R' ) ) THEN
126 *
127 * w := C1 + C2 * v
128 *
129 CALL DCOPY( M, C1, 1, WORK, 1 )
130 CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
131 $ WORK, 1 )
132 *
133 * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T]
134 *
135 CALL DAXPY( M, -TAU, WORK, 1, C1, 1 )
136 CALL DGER( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
137 END IF
138 *
139 RETURN
140 *
141 * End of DLATZM
142 *
143 END