![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
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