Annotation of rpl/lapack/lapack/dlarz.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, 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, L, LDC, M, N
! 11: DOUBLE PRECISION TAU
! 12: * ..
! 13: * .. Array Arguments ..
! 14: DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
! 15: * ..
! 16: *
! 17: * Purpose
! 18: * =======
! 19: *
! 20: * DLARZ applies a real elementary reflector H to a real M-by-N
! 21: * matrix C, from either the left or the right. H is represented in the
! 22: * 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: *
! 31: * H is a product of k elementary reflectors as returned by DTZRZF.
! 32: *
! 33: * Arguments
! 34: * =========
! 35: *
! 36: * SIDE (input) CHARACTER*1
! 37: * = 'L': form H * C
! 38: * = 'R': form C * H
! 39: *
! 40: * M (input) INTEGER
! 41: * The number of rows of the matrix C.
! 42: *
! 43: * N (input) INTEGER
! 44: * The number of columns of the matrix C.
! 45: *
! 46: * L (input) INTEGER
! 47: * The number of entries of the vector V containing
! 48: * the meaningful part of the Householder vectors.
! 49: * If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
! 50: *
! 51: * V (input) DOUBLE PRECISION array, dimension (1+(L-1)*abs(INCV))
! 52: * The vector v in the representation of H as returned by
! 53: * DTZRZF. V is not used if TAU = 0.
! 54: *
! 55: * INCV (input) INTEGER
! 56: * The increment between elements of v. INCV <> 0.
! 57: *
! 58: * TAU (input) DOUBLE PRECISION
! 59: * The value tau in the representation of H.
! 60: *
! 61: * C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
! 62: * On entry, the M-by-N matrix C.
! 63: * On exit, C is overwritten by the matrix H * C if SIDE = 'L',
! 64: * or C * H if SIDE = 'R'.
! 65: *
! 66: * LDC (input) INTEGER
! 67: * The leading dimension of the array C. LDC >= max(1,M).
! 68: *
! 69: * WORK (workspace) DOUBLE PRECISION array, dimension
! 70: * (N) if SIDE = 'L'
! 71: * or (M) if SIDE = 'R'
! 72: *
! 73: * Further Details
! 74: * ===============
! 75: *
! 76: * Based on contributions by
! 77: * A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
! 78: *
! 79: * =====================================================================
! 80: *
! 81: * .. Parameters ..
! 82: DOUBLE PRECISION ONE, ZERO
! 83: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
! 84: * ..
! 85: * .. External Subroutines ..
! 86: EXTERNAL DAXPY, DCOPY, DGEMV, DGER
! 87: * ..
! 88: * .. External Functions ..
! 89: LOGICAL LSAME
! 90: EXTERNAL LSAME
! 91: * ..
! 92: * .. Executable Statements ..
! 93: *
! 94: IF( LSAME( SIDE, 'L' ) ) THEN
! 95: *
! 96: * Form H * C
! 97: *
! 98: IF( TAU.NE.ZERO ) THEN
! 99: *
! 100: * w( 1:n ) = C( 1, 1:n )
! 101: *
! 102: CALL DCOPY( N, C, LDC, WORK, 1 )
! 103: *
! 104: * w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )' * v( 1:l )
! 105: *
! 106: CALL DGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V,
! 107: $ INCV, ONE, WORK, 1 )
! 108: *
! 109: * C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
! 110: *
! 111: CALL DAXPY( N, -TAU, WORK, 1, C, LDC )
! 112: *
! 113: * C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
! 114: * tau * v( 1:l ) * w( 1:n )'
! 115: *
! 116: CALL DGER( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
! 117: $ LDC )
! 118: END IF
! 119: *
! 120: ELSE
! 121: *
! 122: * Form C * H
! 123: *
! 124: IF( TAU.NE.ZERO ) THEN
! 125: *
! 126: * w( 1:m ) = C( 1:m, 1 )
! 127: *
! 128: CALL DCOPY( M, C, 1, WORK, 1 )
! 129: *
! 130: * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
! 131: *
! 132: CALL DGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
! 133: $ V, INCV, ONE, WORK, 1 )
! 134: *
! 135: * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
! 136: *
! 137: CALL DAXPY( M, -TAU, WORK, 1, C, 1 )
! 138: *
! 139: * C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
! 140: * tau * w( 1:m ) * v( 1:l )'
! 141: *
! 142: CALL DGER( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
! 143: $ LDC )
! 144: *
! 145: END IF
! 146: *
! 147: END IF
! 148: *
! 149: RETURN
! 150: *
! 151: * End of DLARZ
! 152: *
! 153: END
CVSweb interface <joel.bertrand@systella.fr>