Return to dlarf.f CVS log

Up to [local] / rpl / lapack / lapack

Annotation of rpl/lapack/lapack/dlarf.f, revision 1.2

1.1       bertrand    1:       SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
                      2:       IMPLICIT NONE
                      3: *
                      4: *  -- LAPACK auxiliary routine (version 3.2) --
                      5: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                      6: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                      7: *     November 2006
                      8: *
                      9: *     .. Scalar Arguments ..
                     10:       CHARACTER          SIDE
                     11:       INTEGER            INCV, LDC, M, N
                     12:       DOUBLE PRECISION   TAU
                     13: *     ..
                     14: *     .. Array Arguments ..
                     15:       DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
                     16: *     ..
                     17: *
                     18: *  Purpose
                     19: *  =======
                     20: *
                     21: *  DLARF applies a real elementary reflector H to a real m by n matrix
                     22: *  C, from either the left or the right. H is represented in the form
                     23: *
                     24: *        H = I - tau * v * v'
                     25: *
                     26: *  where tau is a real scalar and v is a real vector.
                     27: *
                     28: *  If tau = 0, then H is taken to be the unit matrix.
                     29: *
                     30: *  Arguments
                     31: *  =========
                     32: *
                     33: *  SIDE    (input) CHARACTER*1
                     34: *          = 'L': form  H * C
                     35: *          = 'R': form  C * H
                     36: *
                     37: *  M       (input) INTEGER
                     38: *          The number of rows of the matrix C.
                     39: *
                     40: *  N       (input) INTEGER
                     41: *          The number of columns of the matrix C.
                     42: *
                     43: *  V       (input) DOUBLE PRECISION array, dimension
                     44: *                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
                     45: *                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
                     46: *          The vector v in the representation of H. V is not used if
                     47: *          TAU = 0.
                     48: *
                     49: *  INCV    (input) INTEGER
                     50: *          The increment between elements of v. INCV <> 0.
                     51: *
                     52: *  TAU     (input) DOUBLE PRECISION
                     53: *          The value tau in the representation of H.
                     54: *
                     55: *  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
                     56: *          On entry, the m by n matrix C.
                     57: *          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
                     58: *          or C * H if SIDE = 'R'.
                     59: *
                     60: *  LDC     (input) INTEGER
                     61: *          The leading dimension of the array C. LDC >= max(1,M).
                     62: *
                     63: *  WORK    (workspace) DOUBLE PRECISION array, dimension
                     64: *                         (N) if SIDE = 'L'
                     65: *                      or (M) if SIDE = 'R'
                     66: *
                     67: *  =====================================================================
                     68: *
                     69: *     .. Parameters ..
                     70:       DOUBLE PRECISION   ONE, ZERO
                     71:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
                     72: *     ..
                     73: *     .. Local Scalars ..
                     74:       LOGICAL            APPLYLEFT
                     75:       INTEGER            I, LASTV, LASTC
                     76: *     ..
                     77: *     .. External Subroutines ..
                     78:       EXTERNAL           DGEMV, DGER
                     79: *     ..
                     80: *     .. External Functions ..
                     81:       LOGICAL            LSAME
                     82:       INTEGER            ILADLR, ILADLC
                     83:       EXTERNAL           LSAME, ILADLR, ILADLC
                     84: *     ..
                     85: *     .. Executable Statements ..
                     86: *
                     87:       APPLYLEFT = LSAME( SIDE, 'L' )
                     88:       LASTV = 0
                     89:       LASTC = 0
                     90:       IF( TAU.NE.ZERO ) THEN
                     91: !     Set up variables for scanning V.  LASTV begins pointing to the end
                     92: !     of V.
                     93:          IF( APPLYLEFT ) THEN
                     94:             LASTV = M
                     95:          ELSE
                     96:             LASTV = N
                     97:          END IF
                     98:          IF( INCV.GT.0 ) THEN
                     99:             I = 1 + (LASTV-1) * INCV
                    100:          ELSE
                    101:             I = 1
                    102:          END IF
                    103: !     Look for the last non-zero row in V.
                    104:          DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
                    105:             LASTV = LASTV - 1
                    106:             I = I - INCV
                    107:          END DO
                    108:          IF( APPLYLEFT ) THEN
                    109: !     Scan for the last non-zero column in C(1:lastv,:).
                    110:             LASTC = ILADLC(LASTV, N, C, LDC)
                    111:          ELSE
                    112: !     Scan for the last non-zero row in C(:,1:lastv).
                    113:             LASTC = ILADLR(M, LASTV, C, LDC)
                    114:          END IF
                    115:       END IF
                    116: !     Note that lastc.eq.0 renders the BLAS operations null; no special
                    117: !     case is needed at this level.
                    118:       IF( APPLYLEFT ) THEN
                    119: *
                    120: *        Form  H * C
                    121: *
                    122:          IF( LASTV.GT.0 ) THEN
                    123: *
                    124: *           w(1:lastc,1) := C(1:lastv,1:lastc)' * v(1:lastv,1)
                    125: *
                    126:             CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
                    127:      $           ZERO, WORK, 1 )
                    128: *
                    129: *           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)'
                    130: *
                    131:             CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
                    132:          END IF
                    133:       ELSE
                    134: *
                    135: *        Form  C * H
                    136: *
                    137:          IF( LASTV.GT.0 ) THEN
                    138: *
                    139: *           w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
                    140: *
                    141:             CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
                    142:      $           V, INCV, ZERO, WORK, 1 )
                    143: *
                    144: *           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)'
                    145: *
                    146:             CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
                    147:          END IF
                    148:       END IF
                    149:       RETURN
                    150: *
                    151: *     End of DLARF
                    152: *
                    153:       END