Return to dlatzm.f CVS log

Up to [local] / rpl / lapack / lapack

Initial revision

    1:       SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, 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, 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',   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' * 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