001:       SUBROUTINE DLATZM( 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:       DOUBLE PRECISION   TAU
012: *     ..
013: *     .. Array Arguments ..
014:       DOUBLE PRECISION   C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
015: *     ..
016: *
017: *  Purpose
018: *  =======
019: *
020: *  This routine is deprecated and has been replaced by routine DORMRZ.
021: *
022: *  DLATZM applies a Householder matrix generated by DTZRQF 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) DOUBLE PRECISION 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) DOUBLE PRECISION
063: *          The value tau in the representation of P.
064: *
065: *  C1      (input/output) DOUBLE PRECISION 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) DOUBLE PRECISION 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. LDC >= (1,M).
085: *
086: *  WORK    (workspace) DOUBLE PRECISION array, dimension
087: *                      (N) if SIDE = 'L'
088: *                      (M) if SIDE = 'R'
089: *
090: *  =====================================================================
091: *
092: *     .. Parameters ..
093:       DOUBLE PRECISION   ONE, ZERO
094:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
095: *     ..
096: *     .. External Subroutines ..
097:       EXTERNAL           DAXPY, DCOPY, DGEMV, DGER
098: *     ..
099: *     .. 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' * C2
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'
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']
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
144: