001:       SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       CHARACTER          SIDE
010:       INTEGER            INCV, LDC, M, N
011:       COMPLEX*16         TAU
012: *     ..
013: *     .. Array Arguments ..
014:       COMPLEX*16         C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
015: *     ..
016: *
017: *  Purpose
018: *  =======
019: *
020: *  This routine is deprecated and has been replaced by routine ZUNMRZ.
021: *
022: *  ZLATZM applies a Householder matrix generated by ZTZRQF to a matrix.
023: *
024: *  Let P = I - tau*u*u',   u = ( 1 ),
025: *                              ( v )
026: *  where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
027: *  SIDE = 'R'.
028: *
029: *  If SIDE equals 'L', let
030: *         C = [ C1 ] 1
031: *             [ C2 ] m-1
032: *               n
033: *  Then C is overwritten by P*C.
034: *
035: *  If SIDE equals 'R', let
036: *         C = [ C1, C2 ] m
037: *                1  n-1
038: *  Then C is overwritten by C*P.
039: *
040: *  Arguments
041: *  =========
042: *
043: *  SIDE    (input) CHARACTER*1
044: *          = 'L': form P * C
045: *          = 'R': form C * P
046: *
047: *  M       (input) INTEGER
048: *          The number of rows of the matrix C.
049: *
050: *  N       (input) INTEGER
051: *          The number of columns of the matrix C.
052: *
053: *  V       (input) COMPLEX*16 array, dimension
054: *                  (1 + (M-1)*abs(INCV)) if SIDE = 'L'
055: *                  (1 + (N-1)*abs(INCV)) if SIDE = 'R'
056: *          The vector v in the representation of P. V is not used
057: *          if TAU = 0.
058: *
059: *  INCV    (input) INTEGER
060: *          The increment between elements of v. INCV <> 0
061: *
062: *  TAU     (input) COMPLEX*16
063: *          The value tau in the representation of P.
064: *
065: *  C1      (input/output) COMPLEX*16 array, dimension
066: *                         (LDC,N) if SIDE = 'L'
067: *                         (M,1)   if SIDE = 'R'
068: *          On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
069: *          if SIDE = 'R'.
070: *
071: *          On exit, the first row of P*C if SIDE = 'L', or the first
072: *          column of C*P if SIDE = 'R'.
073: *
074: *  C2      (input/output) COMPLEX*16 array, dimension
075: *                         (LDC, N)   if SIDE = 'L'
076: *                         (LDC, N-1) if SIDE = 'R'
077: *          On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
078: *          m x (n - 1) matrix C2 if SIDE = 'R'.
079: *
080: *          On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
081: *          if SIDE = 'R'.
082: *
083: *  LDC     (input) INTEGER
084: *          The leading dimension of the arrays C1 and C2.
085: *          LDC >= max(1,M).
086: *
087: *  WORK    (workspace) COMPLEX*16 array, dimension
088: *                      (N) if SIDE = 'L'
089: *                      (M) if SIDE = 'R'
090: *
091: *  =====================================================================
092: *
093: *     .. Parameters ..
094:       COMPLEX*16         ONE, ZERO
095:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
096:      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
097: *     ..
098: *     .. External Subroutines ..
099:       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 :=  conjg( C1 + v' * C2 )
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'
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']
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
148: