Return to zlatzm.f CVS log

Up to [local] / rpl / lapack / lapack

Patches pour OS/2

    1:       SUBROUTINE ZLATZM( 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:       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',   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 :=  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