1 SUBROUTINE ZLATZM( 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 COMPLEX*16 TAU
12 * ..
13 * .. Array Arguments ..
14 COMPLEX*16 C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * This routine is deprecated and has been replaced by routine ZUNMRZ.
21 *
22 * ZLATZM applies a Householder matrix generated by ZTZRQF to a matrix.
23 *
24 * Let P = I - tau*u*u**H, 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) COMPLEX*16 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) COMPLEX*16
63 * The value tau in the representation of P.
64 *
65 * C1 (input/output) COMPLEX*16 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) COMPLEX*16 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.
85 * LDC >= max(1,M).
86 *
87 * WORK (workspace) COMPLEX*16 array, dimension
88 * (N) if SIDE = 'L'
89 * (M) if SIDE = 'R'
90 *
91 * =====================================================================
92 *
93 * .. Parameters ..
94 COMPLEX*16 ONE, ZERO
95 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
96 $ ZERO = ( 0.0D+0, 0.0D+0 ) )
97 * ..
98 * .. External Subroutines ..
99 EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
100 * ..
101 * .. External Functions ..
102 LOGICAL LSAME
103 EXTERNAL LSAME
104 * ..
105 * .. Intrinsic Functions ..
106 INTRINSIC MIN
107 * ..
108 * .. Executable Statements ..
109 *
110 IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
111 $ RETURN
112 *
113 IF( LSAME( SIDE, 'L' ) ) THEN
114 *
115 * w := ( C1 + v**H * C2 )**H
116 *
117 CALL ZCOPY( N, C1, LDC, WORK, 1 )
118 CALL ZLACGV( N, WORK, 1 )
119 CALL ZGEMV( 'Conjugate transpose', M-1, N, ONE, C2, LDC, V,
120 $ INCV, ONE, WORK, 1 )
121 *
122 * [ C1 ] := [ C1 ] - tau* [ 1 ] * w**H
123 * [ C2 ] [ C2 ] [ v ]
124 *
125 CALL ZLACGV( N, WORK, 1 )
126 CALL ZAXPY( N, -TAU, WORK, 1, C1, LDC )
127 CALL ZGERU( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
128 *
129 ELSE IF( LSAME( SIDE, 'R' ) ) THEN
130 *
131 * w := C1 + C2 * v
132 *
133 CALL ZCOPY( M, C1, 1, WORK, 1 )
134 CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
135 $ WORK, 1 )
136 *
137 * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H]
138 *
139 CALL ZAXPY( M, -TAU, WORK, 1, C1, 1 )
140 CALL ZGERC( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
141 END IF
142 *
143 RETURN
144 *
145 * End of ZLATZM
146 *
147 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 COMPLEX*16 TAU
12 * ..
13 * .. Array Arguments ..
14 COMPLEX*16 C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * This routine is deprecated and has been replaced by routine ZUNMRZ.
21 *
22 * ZLATZM applies a Householder matrix generated by ZTZRQF to a matrix.
23 *
24 * Let P = I - tau*u*u**H, 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) COMPLEX*16 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) COMPLEX*16
63 * The value tau in the representation of P.
64 *
65 * C1 (input/output) COMPLEX*16 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) COMPLEX*16 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.
85 * LDC >= max(1,M).
86 *
87 * WORK (workspace) COMPLEX*16 array, dimension
88 * (N) if SIDE = 'L'
89 * (M) if SIDE = 'R'
90 *
91 * =====================================================================
92 *
93 * .. Parameters ..
94 COMPLEX*16 ONE, ZERO
95 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
96 $ ZERO = ( 0.0D+0, 0.0D+0 ) )
97 * ..
98 * .. External Subroutines ..
99 EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
100 * ..
101 * .. External Functions ..
102 LOGICAL LSAME
103 EXTERNAL LSAME
104 * ..
105 * .. Intrinsic Functions ..
106 INTRINSIC MIN
107 * ..
108 * .. Executable Statements ..
109 *
110 IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
111 $ RETURN
112 *
113 IF( LSAME( SIDE, 'L' ) ) THEN
114 *
115 * w := ( C1 + v**H * C2 )**H
116 *
117 CALL ZCOPY( N, C1, LDC, WORK, 1 )
118 CALL ZLACGV( N, WORK, 1 )
119 CALL ZGEMV( 'Conjugate transpose', M-1, N, ONE, C2, LDC, V,
120 $ INCV, ONE, WORK, 1 )
121 *
122 * [ C1 ] := [ C1 ] - tau* [ 1 ] * w**H
123 * [ C2 ] [ C2 ] [ v ]
124 *
125 CALL ZLACGV( N, WORK, 1 )
126 CALL ZAXPY( N, -TAU, WORK, 1, C1, LDC )
127 CALL ZGERU( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
128 *
129 ELSE IF( LSAME( SIDE, 'R' ) ) THEN
130 *
131 * w := C1 + C2 * v
132 *
133 CALL ZCOPY( M, C1, 1, WORK, 1 )
134 CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
135 $ WORK, 1 )
136 *
137 * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H]
138 *
139 CALL ZAXPY( M, -TAU, WORK, 1, C1, 1 )
140 CALL ZGERC( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
141 END IF
142 *
143 RETURN
144 *
145 * End of ZLATZM
146 *
147 END