Return to zlatzm.f CVS log

Up to [local] / rpl / lapack / lapack

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

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