Return to dlatzm.f CVS log

Up to [local] / rpl / lapack / lapack

Annotation of rpl/lapack/lapack/dlatzm.f, revision 1.6

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