Return to zlatzm.f CVS log

Up to [local] / rpl / lapack / lapack

Annotation of rpl/lapack/lapack/zlatzm.f, revision 1.1

1.1     ! bertrand    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