![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE ZLATZM( 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: COMPLEX*16 TAU 12: * .. 13: * .. Array Arguments .. 14: COMPLEX*16 C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * ) 15: * .. 16: * 17: * Purpose 18: * ======= 19: * 20: * This routine is deprecated and has been replaced by routine ZUNMRZ. 21: * 22: * ZLATZM applies a Householder matrix generated by ZTZRQF 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) COMPLEX*16 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) COMPLEX*16 63: * The value tau in the representation of P. 64: * 65: * C1 (input/output) COMPLEX*16 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) COMPLEX*16 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. 85: * LDC >= max(1,M). 86: * 87: * WORK (workspace) COMPLEX*16 array, dimension 88: * (N) if SIDE = 'L' 89: * (M) if SIDE = 'R' 90: * 91: * ===================================================================== 92: * 93: * .. Parameters .. 94: COMPLEX*16 ONE, ZERO 95: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), 96: $ ZERO = ( 0.0D+0, 0.0D+0 ) ) 97: * .. 98: * .. External Subroutines .. 99: EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV 100: * .. 101: * .. External Functions .. 102: LOGICAL LSAME 103: EXTERNAL LSAME 104: * .. 105: * .. Intrinsic Functions .. 106: INTRINSIC MIN 107: * .. 108: * .. Executable Statements .. 109: * 110: IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) ) 111: $ RETURN 112: * 113: IF( LSAME( SIDE, 'L' ) ) THEN 114: * 115: * w := conjg( C1 + v' * C2 ) 116: * 117: CALL ZCOPY( N, C1, LDC, WORK, 1 ) 118: CALL ZLACGV( N, WORK, 1 ) 119: CALL ZGEMV( 'Conjugate transpose', M-1, N, ONE, C2, LDC, V, 120: $ INCV, ONE, WORK, 1 ) 121: * 122: * [ C1 ] := [ C1 ] - tau* [ 1 ] * w' 123: * [ C2 ] [ C2 ] [ v ] 124: * 125: CALL ZLACGV( N, WORK, 1 ) 126: CALL ZAXPY( N, -TAU, WORK, 1, C1, LDC ) 127: CALL ZGERU( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC ) 128: * 129: ELSE IF( LSAME( SIDE, 'R' ) ) THEN 130: * 131: * w := C1 + C2 * v 132: * 133: CALL ZCOPY( M, C1, 1, WORK, 1 ) 134: CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, 135: $ WORK, 1 ) 136: * 137: * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v'] 138: * 139: CALL ZAXPY( M, -TAU, WORK, 1, C1, 1 ) 140: CALL ZGERC( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC ) 141: END IF 142: * 143: RETURN 144: * 145: * End of ZLATZM 146: * 147: END