![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE ZLARZ( 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: COMPLEX*16 TAU 12: * .. 13: * .. Array Arguments .. 14: COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) 15: * .. 16: * 17: * Purpose 18: * ======= 19: * 20: * ZLARZ applies a complex elementary reflector H to a complex 21: * M-by-N matrix C, from either the left or the right. H is represented 22: * in the form 23: * 24: * H = I - tau * v * v' 25: * 26: * where tau is a complex scalar and v is a complex vector. 27: * 28: * If tau = 0, then H is taken to be the unit matrix. 29: * 30: * To apply H' (the conjugate transpose of H), supply conjg(tau) instead 31: * tau. 32: * 33: * H is a product of k elementary reflectors as returned by ZTZRZF. 34: * 35: * Arguments 36: * ========= 37: * 38: * SIDE (input) CHARACTER*1 39: * = 'L': form H * C 40: * = 'R': form C * H 41: * 42: * M (input) INTEGER 43: * The number of rows of the matrix C. 44: * 45: * N (input) INTEGER 46: * The number of columns of the matrix C. 47: * 48: * L (input) INTEGER 49: * The number of entries of the vector V containing 50: * the meaningful part of the Householder vectors. 51: * If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0. 52: * 53: * V (input) COMPLEX*16 array, dimension (1+(L-1)*abs(INCV)) 54: * The vector v in the representation of H as returned by 55: * ZTZRZF. V is not used if TAU = 0. 56: * 57: * INCV (input) INTEGER 58: * The increment between elements of v. INCV <> 0. 59: * 60: * TAU (input) COMPLEX*16 61: * The value tau in the representation of H. 62: * 63: * C (input/output) COMPLEX*16 array, dimension (LDC,N) 64: * On entry, the M-by-N matrix C. 65: * On exit, C is overwritten by the matrix H * C if SIDE = 'L', 66: * or C * H if SIDE = 'R'. 67: * 68: * LDC (input) INTEGER 69: * The leading dimension of the array C. LDC >= max(1,M). 70: * 71: * WORK (workspace) COMPLEX*16 array, dimension 72: * (N) if SIDE = 'L' 73: * or (M) if SIDE = 'R' 74: * 75: * Further Details 76: * =============== 77: * 78: * Based on contributions by 79: * A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA 80: * 81: * ===================================================================== 82: * 83: * .. Parameters .. 84: COMPLEX*16 ONE, ZERO 85: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), 86: $ ZERO = ( 0.0D+0, 0.0D+0 ) ) 87: * .. 88: * .. External Subroutines .. 89: EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV 90: * .. 91: * .. External Functions .. 92: LOGICAL LSAME 93: EXTERNAL LSAME 94: * .. 95: * .. Executable Statements .. 96: * 97: IF( LSAME( SIDE, 'L' ) ) THEN 98: * 99: * Form H * C 100: * 101: IF( TAU.NE.ZERO ) THEN 102: * 103: * w( 1:n ) = conjg( C( 1, 1:n ) ) 104: * 105: CALL ZCOPY( N, C, LDC, WORK, 1 ) 106: CALL ZLACGV( N, WORK, 1 ) 107: * 108: * w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )' * v( 1:l ) ) 109: * 110: CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ), 111: $ LDC, V, INCV, ONE, WORK, 1 ) 112: CALL ZLACGV( N, WORK, 1 ) 113: * 114: * C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n ) 115: * 116: CALL ZAXPY( N, -TAU, WORK, 1, C, LDC ) 117: * 118: * C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ... 119: * tau * v( 1:l ) * conjg( w( 1:n )' ) 120: * 121: CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ), 122: $ LDC ) 123: END IF 124: * 125: ELSE 126: * 127: * Form C * H 128: * 129: IF( TAU.NE.ZERO ) THEN 130: * 131: * w( 1:m ) = C( 1:m, 1 ) 132: * 133: CALL ZCOPY( M, C, 1, WORK, 1 ) 134: * 135: * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l ) 136: * 137: CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC, 138: $ V, INCV, ONE, WORK, 1 ) 139: * 140: * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m ) 141: * 142: CALL ZAXPY( M, -TAU, WORK, 1, C, 1 ) 143: * 144: * C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ... 145: * tau * w( 1:m ) * v( 1:l )' 146: * 147: CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ), 148: $ LDC ) 149: * 150: END IF 151: * 152: END IF 153: * 154: RETURN 155: * 156: * End of ZLARZ 157: * 158: END